+++ /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 -*- lexical-binding: t -*-
-;;
-;;; Code:
-
-(add-to-list 'load-path (directory-file-name
- (or (file-name-directory #$) (car load-path))))
-
-\f
-;;;### (autoloads nil "forge" "forge.el" (0 0 0 0))
-;;; 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.
-
-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.")
-
-(with-eval-after-load 'git-commit (when forge-add-default-bindings (define-key git-commit-mode-map (kbd "C-c C-v") #'forge-visit-topic)))
-
-(with-eval-after-load 'magit-mode (when forge-add-default-bindings (define-key magit-mode-map "'" #'forge-dispatch) (define-key magit-mode-map "N" #'forge-dispatch)))
-
-(register-definition-prefixes "forge" '("forge-"))
-
-;;;***
-\f
-;;;### (autoloads nil "forge-bitbucket" "forge-bitbucket.el" (0 0
-;;;;;; 0 0))
-;;; Generated autoloads from forge-bitbucket.el
-
-(register-definition-prefixes "forge-bitbucket" '("forge-bitbucket-repository"))
-
-;;;***
-\f
-;;;### (autoloads nil "forge-commands" "forge-commands.el" (0 0 0
-;;;;;; 0))
-;;; Generated autoloads from forge-commands.el
- (autoload 'forge-dispatch "forge-commands" nil t)
-
-(autoload 'forge-pull "forge-commands" "\
-Pull topics from the forge repository.
-
-With a prefix argument and if the repository has not been fetched
-before, then read a date from the user and limit pulled topics to
-those that have been updated since then.
-
-If pulling is too slow, then also consider setting the Git variable
-`forge.omitExpensive' to `true'.
-
-\(fn &optional REPO UNTIL)" t nil)
-
-(autoload 'forge-pull-notifications "forge-commands" "\
-Fetch notifications for all repositories from the current forge." t nil)
-
-(autoload 'forge-pull-topic "forge-commands" "\
-Pull the API data for the current topic.
-If there is no current topic or with a prefix argument read a
-TOPIC to pull instead.
-
-\(fn TOPIC)" t nil)
-
-(autoload 'forge-browse-dwim "forge-commands" "\
-Visit a topic, branch or commit using a browser.
-Prefer a topic over a branch and that over a commit." t nil)
-
-(autoload 'forge-browse-commit "forge-commands" "\
-Visit the url corresponding to REV using a browser.
-
-\(fn REV)" t nil)
-
-(autoload 'forge-copy-url-at-point-as-kill "forge-commands" "\
-Copy the url of the thing at point." t nil)
-
-(autoload 'forge-browse-branch "forge-commands" "\
-Visit the url corresponding BRANCH using a browser.
-
-\(fn BRANCH)" t nil)
-
-(autoload 'forge-browse-remote "forge-commands" "\
-Visit the url corresponding to REMOTE using a browser.
-
-\(fn REMOTE)" t nil)
-
-(autoload 'forge-browse-repository "forge-commands" "\
-View the current repository in a separate buffer.
-
-\(fn REPO)" t nil)
-
-(autoload 'forge-browse-topic "forge-commands" "\
-Visit the current topic using a browser." t nil)
-
-(autoload 'forge-browse-pullreqs "forge-commands" "\
-Visit the pull-requests of the current repository using a browser." t nil)
-
-(autoload 'forge-browse-pullreq "forge-commands" "\
-Visit the url corresponding to PULLREQ using a browser.
-
-\(fn PULLREQ)" t nil)
-
-(autoload 'forge-browse-issues "forge-commands" "\
-Visit the issues of the current repository using a browser." t nil)
-
-(autoload 'forge-browse-issue "forge-commands" "\
-Visit the current issue using a browser.
-If there is no current issue or with a prefix argument
-read an ISSUE to visit.
-
-\(fn ISSUE)" t nil)
-
-(autoload 'forge-browse-post "forge-commands" "\
-Visit the current post using a browser." t nil)
-
-(autoload 'forge-visit-topic "forge-commands" "\
-View the current topic in a separate buffer.
-If there is no current topic or with a prefix argument
-read a topic to visit instead.
-
-\(fn TOPIC)" t nil)
-
-(autoload 'forge-visit-pullreq "forge-commands" "\
-View the current pull-request in a separate buffer.
-If there is no current pull-request or with a prefix argument
-read a PULLREQ to visit instead. If point is looking at a pullreq
-reference with Gitlab/Github notation try to visit the pullreq
-with that number.
-
-\(fn PULLREQ)" t nil)
-
-(autoload 'forge-visit-issue "forge-commands" "\
-Visit the current issue in a separate buffer.
-If there is no current issue or with a prefix argument read an
-ISSUE to visit instead. If point is looking at an issue reference
-with Gitlab/Github notation try to visit the issue with that
-number.
-
-\(fn ISSUE)" t nil)
-
-(autoload 'forge-visit-repository "forge-commands" "\
-View the current repository in a separate buffer.
-
-\(fn REPO)" t nil)
-
-(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 nil)
-
-(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 nil)
-
-(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 nil)
-
-(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 nil)
-
-(autoload 'forge-list-notifications "forge-commands" "\
-List notifications." t nil)
-
-(autoload 'forge-add-pullreq-refspec "forge-commands" "\
-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." t nil)
-
-(autoload 'forge-add-repository "forge-commands" "\
-Add a repository to the database.
-Offer to either pull topics (now and in the future) or to only
-pull individual topics when the user invokes `forge-pull-topic'.
-
-\(fn URL)" t nil)
-
-(function-put 'forge-add-repository 'interactive-only '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 nil)
-
-(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 nil)
-
-(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 nil)
-
-(autoload 'forge-remove-repository "forge-commands" "\
-Remove a repository from the database.
-
-\(fn HOST OWNER NAME)" t nil)
-
-(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 nil)
-
-(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 nil)
-
-(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 nil)
-
-(register-definition-prefixes "forge-commands" '("forge-"))
-
-;;;***
-\f
-;;;### (autoloads nil "forge-core" "forge-core.el" (0 0 0 0))
-;;; Generated autoloads from forge-core.el
-
-(register-definition-prefixes "forge-core" '("forge-"))
-
-;;;***
-\f
-;;;### (autoloads nil "forge-db" "forge-db.el" (0 0 0 0))
-;;; Generated autoloads from forge-db.el
-
-(register-definition-prefixes "forge-db" '("forge-"))
-
-;;;***
-\f
-;;;### (autoloads nil "forge-gitea" "forge-gitea.el" (0 0 0 0))
-;;; Generated autoloads from forge-gitea.el
-
-(register-definition-prefixes "forge-gitea" '("forge-gitea-repository"))
-
-;;;***
-\f
-;;;### (autoloads nil "forge-github" "forge-github.el" (0 0 0 0))
-;;; Generated autoloads from forge-github.el
-
-(register-definition-prefixes "forge-github" '("forge-"))
-
-;;;***
-\f
-;;;### (autoloads nil "forge-gitlab" "forge-gitlab.el" (0 0 0 0))
-;;; Generated autoloads from forge-gitlab.el
-
-(register-definition-prefixes "forge-gitlab" '("forge-gitlab-repository"))
-
-;;;***
-\f
-;;;### (autoloads nil "forge-gogs" "forge-gogs.el" (0 0 0 0))
-;;; Generated autoloads from forge-gogs.el
-
-(register-definition-prefixes "forge-gogs" '("forge-gogs-repository"))
-
-;;;***
-\f
-;;;### (autoloads nil "forge-issue" "forge-issue.el" (0 0 0 0))
-;;; Generated autoloads from forge-issue.el
-
-(register-definition-prefixes "forge-issue" '("forge-"))
-
-;;;***
-\f
-;;;### (autoloads nil "forge-list" "forge-list.el" (0 0 0 0))
-;;; Generated autoloads from forge-list.el
-
-(autoload 'forge-list-topics "forge-list" "\
-List topics of the current repository in a separate buffer.
-
-\(fn ID)" t nil)
-
-(autoload 'forge-list-issues "forge-list" "\
-List issues of the current repository in a separate buffer.
-
-\(fn ID)" t nil)
-
-(autoload 'forge-list-labeled-issues "forge-list" "\
-List issues of the current repository that have LABEL.
-List them in a separate buffer.
-
-\(fn ID LABEL)" t nil)
-
-(autoload 'forge-list-assigned-issues "forge-list" "\
-List issues of the current repository that are assigned to you.
-List them in a separate buffer.
-
-\(fn ID)" t nil)
-
-(autoload 'forge-list-owned-issues "forge-list" "\
-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." t nil)
-
-(autoload 'forge-list-pullreqs "forge-list" "\
-List pull-requests of the current repository in a separate buffer.
-
-\(fn ID)" t nil)
-
-(autoload 'forge-list-labeled-pullreqs "forge-list" "\
-List pull-requests of the current repository that have LABEL.
-List them in a separate buffer.
-
-\(fn ID LABEL)" t nil)
-
-(autoload 'forge-list-assigned-pullreqs "forge-list" "\
-List pull-requests of the current repository that are assigned to you.
-List them in a separate buffer.
-
-\(fn ID)" t nil)
-
-(autoload 'forge-list-requested-reviews "forge-list" "\
-List pull-requests of the current repository that are awaiting your review.
-List them in a separate buffer.
-
-\(fn ID)" t nil)
-
-(autoload 'forge-list-owned-pullreqs "forge-list" "\
-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." t nil)
-
-(autoload 'forge-list-authored-pullreqs "forge-list" "\
-List open pull-requests of the current repository that are authored by you.
-List them in a separate buffer.
-
-\(fn ID)" t nil)
-
-(autoload 'forge-list-authored-issues "forge-list" "\
-List open issues from the current repository that are authored by you.
-List them in a separate buffer.
-
-\(fn ID)" t nil)
-
-(autoload 'forge-list-repositories "forge-list" "\
-List known repositories in a separate buffer.
-Here \"known\" means that an entry exists in the local database." t nil)
-
-(autoload 'forge-list-owned-repositories "forge-list" "\
-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." t nil)
-
-(register-definition-prefixes "forge-list" '("forge-"))
-
-;;;***
-\f
-;;;### (autoloads nil "forge-notify" "forge-notify.el" (0 0 0 0))
-;;; Generated autoloads from forge-notify.el
-
-(register-definition-prefixes "forge-notify" '("forge-"))
-
-;;;***
-\f
-;;;### (autoloads nil "forge-post" "forge-post.el" (0 0 0 0))
-;;; Generated autoloads from forge-post.el
-
-(register-definition-prefixes "forge-post" '("forge-"))
-
-;;;***
-\f
-;;;### (autoloads nil "forge-pullreq" "forge-pullreq.el" (0 0 0 0))
-;;; Generated autoloads from forge-pullreq.el
-
-(register-definition-prefixes "forge-pullreq" '("forge-"))
-
-;;;***
-\f
-;;;### (autoloads nil "forge-repo" "forge-repo.el" (0 0 0 0))
-;;; Generated autoloads from forge-repo.el
-
-(register-definition-prefixes "forge-repo" '("forge-"))
-
-;;;***
-\f
-;;;### (autoloads nil "forge-revnote" "forge-revnote.el" (0 0 0 0))
-;;; Generated autoloads from forge-revnote.el
-
-(register-definition-prefixes "forge-revnote" '("forge-revnote"))
-
-;;;***
-\f
-;;;### (autoloads nil "forge-semi" "forge-semi.el" (0 0 0 0))
-;;; Generated autoloads from forge-semi.el
-
-(register-definition-prefixes "forge-semi" '("forge-"))
-
-;;;***
-\f
-;;;### (autoloads nil "forge-topic" "forge-topic.el" (0 0 0 0))
-;;; Generated autoloads from forge-topic.el
-
-(register-definition-prefixes "forge-topic" '("forge-"))
-
-;;;***
-\f
-;;;### (autoloads nil nil ("forge-pkg.el") (0 0 0 0))
-
-;;;***
-\f
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; coding: utf-8
-;; End:
-;;; forge-autoloads.el ends here
+++ /dev/null
-;;; forge-bitbucket.el --- Bitbucket support -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2023 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-
-;; 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-2023 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-
-;; 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."
- [["Fetch"
- ("f f" "all topics" forge-pull)
- ("f t" "one topic" forge-pull-topic)
- ("f n" "notifications" forge-pull-notifications)
- """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 (lambda () (forge-github-repository-p (forge-get-repository nil))))
- ("c f" "fork or remote" forge-fork)
- """Merge"
- (7 "M " "merge using API" forge-merge)]
- ["List"
- ("l t" "topics" forge-list-topics)
- ("l i" "issues" forge-list-issues)
- ("l p" "pull-requests" forge-list-pullreqs)
- ("l n" "notifications" forge-list-notifications)
- ("l r" "repositories" forge-list-repositories)
- (7 "l a" "awaiting review" forge-list-requested-reviews)
- (7 "n i" "labeled issues" forge-list-labeled-issues)
- (7 "n p" "labeled pull-requests" forge-list-labeled-pullreqs)
- (7 "m i" "authored issues" forge-list-authored-issues)
- (7 "m p" "authored pull-requests" forge-list-authored-pullreqs)
- (7 "o i" "owned issues" forge-list-owned-issues)
- (7 "o p" "owned pull-requests" forge-list-owned-pullreqs)
- (7 "o r" "owned repositories" forge-list-owned-repositories)]
- ["Visit"
- ("v t" "topic" forge-visit-topic)
- ("v i" "issue" forge-visit-issue)
- ("v p" "pull-request" forge-visit-pullreq)
- """Browse"
- ("b I" "issues" forge-browse-issues)
- ("b P" "pull-requests" forge-browse-pullreqs)
- ("b t" "topic" forge-browse-topic)
- ("b i" "issue" forge-browse-issue)
- ("b p" "pull-request" forge-browse-pullreq)
- ("b r" "remote" forge-browse-remote)]]
- [["Configure"
- ("a " "add repository to database" forge-add-repository)
- ("r " "forge.remote" forge-forge.remote)
- ("t l" "forge.graphqlItemLimit" forge-forge.graphqlItemLimit
- :if (lambda () (forge-github-repository-p (forge-get-repository nil))))
- ("t t" forge-toggle-display-in-status-buffer)
- ("t c" forge-toggle-closed-visibility)]])
-
-;;; Pull
-
-;;;###autoload
-(defun forge-pull (&optional repo until interactive)
- "Pull topics from the forge repository.
-
-With a prefix argument and if the repository has not been fetched
-before, then read a date from the user and limit pulled topics to
-those that have been updated since then.
-
-If pulling is too slow, then also consider setting the Git variable
-`forge.omitExpensive' to `true'.
-\n(fn &optional REPO UNTIL)"
- (interactive
- (list nil
- (and current-prefix-arg
- (not (forge-get-repository 'full))
- (forge-read-date "Limit pulling to topics updates since: "))
- t))
- (let (create)
- (unless repo
- (setq repo (forge-get-repository 'full))
- (unless repo
- (setq repo (forge-get-repository 'create))
- (setq create t)))
- (when (or create interactive (magit-git-config-p "forge.autoPull" t))
- (forge--zap-repository-cache repo)
- (when (and interactive
- (oref repo selective-p)
- (yes-or-no-p
- (format "Always pull all of %s/%s's topics going forward?"
- (oref repo owner)
- (oref repo name))))
- (oset repo selective-p nil))
- (setq forge--mode-line-buffer (current-buffer))
- (when-let* ((remote (oref repo remote))
- (refspec (oref repo pullreq-refspec)))
- (when (and create
- (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)))
- (forge--msg repo t nil "Pulling REPO")
- (forge--pull repo until))))
-
-(defun forge-read-date (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) _until) ; NOOP
- (forge--msg repo t t "Pulling from REPO is not supported"))
-
-(cl-defmethod forge--pull ((repo forge-unusedapi-repository) _until)
- (oset repo sparse-p nil)
- (magit-git-fetch (oref repo remote) (magit-fetch-arguments)))
-
-(defun forge--git-fetch (buf dir repo)
- (if (buffer-live-p buf)
- (with-current-buffer buf
- (magit-git-fetch (oref repo remote) (magit-fetch-arguments)))
- (let ((default-directory dir))
- (magit-git-fetch (oref repo remote) (magit-fetch-arguments)))))
-
-;;;###autoload
-(defun forge-pull-notifications ()
- "Fetch notifications for all repositories from the current forge."
- (interactive)
- (let* ((repo (forge-get-repository 'stub))
- (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)))))
-
-;;;###autoload
-(defun forge-pull-topic (topic)
- "Pull the API data for the current topic.
-If there is no current topic or with a prefix argument read a
-TOPIC to pull instead."
- (interactive (list (forge-read-topic "Pull topic" nil t)))
- (let ((repo (forge-get-repository t)))
- (forge--zap-repository-cache repo)
- (forge--pull-topic repo
- (if (numberp topic)
- (forge-issue :repository (oref repo id)
- :number topic)
- (forge-get-topic topic)))))
-
-(cl-defmethod forge--pull-topic ((repo forge-repository) _topic)
- (error "Fetching an individual topic not implemented for %s"
- (eieio-object-class repo)))
-
-(defun forge--zap-repository-cache (&optional repo)
- (when-let ((r (if repo
- (oref repo worktree)
- (magit-repository-local-repository))))
- (magit-repository-local-delete (list 'forge-ls-recent-topics 'issue) r)
- (magit-repository-local-delete (list 'forge-ls-recent-topics 'pullreq) r)))
-
-;;; Browse
-
-;;;###autoload
-(defun forge-browse-dwim ()
- "Visit a topic, branch or commit using a browser.
-Prefer a topic over a branch and that over a commit."
- (interactive)
- (if-let ((topic (forge-topic-at-point)))
- (forge-browse topic)
- (if-let ((branch (magit-branch-at-point)))
- (forge-browse-branch branch)
- (call-interactively #'forge-browse-commit))))
-
-;;;###autoload
-(defun forge-browse-commit (rev)
- "Visit the url corresponding to REV 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"))))
- (let ((repo (forge-get-repository 'stub)))
- (unless (magit-list-containing-branches
- rev "-r" (concat (oref repo remote) "/*"))
- (if-let ((branch (car (magit-list-containing-branches rev "-r"))))
- (setq repo (forge-get-repository
- 'stub (cdr (magit-split-branch-name branch))))
- (message "%s does not appear to be available on any remote. %s"
- rev "You might have to push it first.")))
- (browse-url
- (forge--format repo 'commit-url-format
- `((?r . ,(magit-commit-p rev)))))))
-
-;;;###autoload
-(defun forge-copy-url-at-point-as-kill ()
- "Copy the url of the thing at point."
- (interactive)
- (if-let ((url (forge-get-url (or (forge-post-at-point)
- (forge-current-topic)))))
- (progn
- (kill-new url)
- (message "Copied %S" url))
- (user-error "Nothing at point with a URL")))
-
-;;;###autoload
-(defun forge-browse-branch (branch)
- "Visit the url corresponding BRANCH using a browser."
- (interactive (list (magit-read-branch "Browse branch")))
- (let (remote)
- (if (magit-remote-branch-p branch)
- (let ((cons (magit-split-branch-name branch)))
- (setq remote (car cons))
- (setq branch (cdr cons)))
- (or (setq remote (or (magit-get-push-remote branch)
- (magit-get-upstream-remote branch)))
- (user-error "Cannot determine remote for %s" branch)))
- (browse-url (forge--format remote 'branch-url-format
- `((?r . ,branch))))))
-
-;;;###autoload
-(defun forge-browse-remote (remote)
- "Visit the url corresponding to REMOTE using a browser."
- (interactive (list (magit-read-remote "Browse remote")))
- (browse-url (forge--format remote 'remote-url-format)))
-
-;;;###autoload
-(defun forge-browse-repository (repo)
- "View the current repository in a separate buffer."
- (interactive
- (list (or (forge-current-repository)
- (forge-get-repository
- (forge-read-repository "Browse repository")))))
- (browse-url (forge--format repo 'remote-url-format)))
-
-;;;###autoload
-(defun forge-browse-topic ()
- "Visit the current topic using a browser."
- (interactive)
- (if-let ((topic (forge-current-topic)))
- (forge-browse topic)
- (user-error "There is no current topic")))
-
-;;;###autoload
-(defun forge-browse-pullreqs ()
- "Visit the pull-requests of the current repository using a browser."
- (interactive)
- (browse-url (forge--format (forge-get-repository 'stub)
- 'pullreqs-url-format)))
-
-;;;###autoload
-(defun forge-browse-pullreq (pullreq)
- "Visit the url corresponding to PULLREQ using a browser."
- (interactive (list (forge-read-pullreq "Browse pull-request" t)))
- (forge-browse (forge-get-pullreq pullreq)))
-
-;;;###autoload
-(defun forge-browse-issues ()
- "Visit the issues of the current repository using a browser."
- (interactive)
- (browse-url (forge--format (forge-get-repository 'stub)
- 'issues-url-format)))
-
-;;;###autoload
-(defun forge-browse-issue (issue)
- "Visit the current issue using a browser.
-If there is no current issue or with a prefix argument
-read an ISSUE to visit."
- (interactive (list (forge-read-issue "Browse issue" t)))
- (forge-browse (forge-get-issue issue)))
-
-;;;###autoload
-(defun forge-browse-post ()
- "Visit the current post using a browser."
- (interactive)
- (if-let ((post (forge-post-at-point)))
- (forge-browse post)
- (user-error "There is no current post")))
-
-;;; Visit
-
-;;;###autoload
-(defun forge-visit-topic (topic)
- "View the current topic in a separate buffer.
-If there is no current topic or with a prefix argument
-read a topic to visit instead."
- (interactive (list (if-let ((topic (forge-current-topic)))
- (oref topic id)
- (forge-read-topic "View topic"))))
- (forge-visit (forge-get-topic topic)))
-
-;;;###autoload
-(defun forge-visit-pullreq (pullreq)
- "View the current pull-request in a separate buffer.
-If there is no current pull-request or with a prefix argument
-read a PULLREQ to visit instead. If point is looking at a pullreq
-reference with Gitlab/Github notation try to visit the pullreq
-with that number."
- (interactive (list (forge-read-pullreq "View pull-request" t)))
- (forge-visit (forge-get-pullreq pullreq)))
-
-;;;###autoload
-(defun forge-visit-issue (issue)
- "Visit the current issue in a separate buffer.
-If there is no current issue or with a prefix argument read an
-ISSUE to visit instead. If point is looking at an issue reference
-with Gitlab/Github notation try to visit the issue with that
-number."
- (interactive (list (forge-read-issue "View issue" t)))
- (forge-visit (forge-get-issue issue)))
-
-;;;###autoload
-(defun forge-visit-repository (repo)
- "View the current repository in a separate buffer."
- (interactive
- (list (or (forge-current-repository)
- (forge-get-repository
- (forge-read-repository "Visit repository")))))
- (forge-visit repo))
-
-;;; Create
-
-(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 t))
- (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)))
-
-(defun forge-create-pullreq-from-issue (issue source target)
- "Convert an existing ISSUE into a pull-request."
- (interactive (cons (forge-read-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 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
- (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-issue ()
- "Create a new issue for the current repository."
- (interactive)
- (let* ((repo (forge-get-repository t))
- (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-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 (or (forge-post-at-point)
- (user-error "There is no current post")))
- (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)))
-
-(defun forge-edit-topic-title (topic)
- "Edit the title of the current topic.
-If there is no current topic or with a prefix argument read a
-TOPIC and modify that instead."
- (interactive (list (forge-read-topic "Edit title of")))
- (let ((topic (forge-get-topic topic)))
- (forge--set-topic-title
- (forge-get-repository topic) topic
- (read-string "Title: " (oref topic title)))))
-
-(defun forge-edit-topic-state (topic)
- "Close or reopen the current topic.
-If there is no current topic or with a prefix argument read a
-TOPIC and modify that instead."
- (interactive
- (let* ((id (forge-read-topic "Close/reopen"))
- (topic (forge-get-topic id)))
- (if (magit-y-or-n-p
- (format "%s %S"
- (cl-ecase (oref topic state)
- (merged (error "Merged pull-requests cannot be reopened"))
- (closed "Reopen")
- (open "Close"))
- (car (forge--topic-format-choice topic))))
- (list id)
- (user-error "Abort"))))
- (let ((topic (forge-get-topic topic)))
- (forge--set-topic-state (forge-get-repository topic) topic)))
-
-(defun forge-edit-topic-draft (pullreq)
- "Toggle whether the current pull-request is a draft.
-If there is no current topic or with a prefix argument read a
-TOPIC and modify that instead."
- (interactive (list (forge-read-pullreq "Toggle draft state of")))
- (let ((pullreq (forge-get-pullreq pullreq)))
- (forge--set-topic-draft (forge-get-repository pullreq)
- pullreq
- (not (oref pullreq draft-p)))))
-
-(defun forge-edit-topic-milestone (topic)
- (interactive (list (forge-read-topic "Edit milestone of")))
- (let* ((topic (forge-get-topic topic))
- (repo (forge-get-repository topic)))
- (forge--set-topic-milestone
- repo topic
- (magit-completing-read
- "Milestone"
- (mapcar #'caddr (oref repo milestones))
- nil t (forge--get-topic-milestone topic)))))
-
-(defun forge-edit-topic-labels (topic)
- "Edit the labels of the current topic.
-If there is no current topic or with a prefix argument read a
-TOPIC and modify that instead."
- (interactive (list (forge-read-topic "Edit labels of")))
- (let* ((topic (forge-get-topic topic))
- (repo (forge-get-repository topic))
- (crm-separator ","))
- (forge--set-topic-labels
- repo topic (magit-completing-read-multiple
- "Labels: "
- (mapcar #'cadr (oref repo labels))
- nil t
- (mapconcat #'car (closql--iref topic 'labels) ",")))))
-
-(defun forge-edit-topic-marks (topic marks)
- "Edit the marks of the current topic.
-If there is no current topic or with a prefix argument read a
-TOPIC and modify that instead."
- (interactive
- (let ((topic (forge-read-topic "Edit marks of")))
- (list topic (forge-read-marks "Marks: " (forge-get-topic topic)))))
- (oset (forge-get-topic topic) marks marks)
- (magit-refresh))
-
-(defun forge-edit-topic-assignees (topic)
- "Edit the assignees of the current topic.
-If there is no current topic or with a prefix argument read a
-TOPIC and modify that instead."
- (interactive (list (forge-read-topic "Edit assignees of")))
- (let* ((topic (forge-get-topic topic))
- (repo (forge-get-repository topic))
- (value (closql--iref topic 'assignees))
- (choices (mapcar #'cadr (oref repo assignees)))
- (crm-separator ","))
- (forge--set-topic-assignees
- repo topic
- (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-edit-topic-review-requests (pullreq)
- "Edit the review-requests of the current pull-request.
-If there is no current topic or with a prefix argument read a
-PULLREQ and modify that instead."
- (interactive (list (forge-read-pullreq "Request review for")))
- (let* ((topic (forge-get-pullreq pullreq))
- (repo (forge-get-repository topic))
- (value (closql--iref topic 'review-requests))
- (choices (mapcar #'cadr (oref repo assignees)))
- (crm-separator ","))
- (forge--set-topic-review-requests
- repo topic
- (magit-completing-read-multiple
- "Request review from: " choices nil
- 'confirm
- (mapconcat #'car value ",")))))
-
-(defun forge-edit-topic-note (topic)
- "Edit your private note about the current topic.
-If there is no current topic or with a prefix argument read a
-TOPIC and modify that instead."
- (interactive (list (forge-read-topic "Edit note about")))
- (let* ((topic (forge-get-topic topic))
- (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
-
-(defun forge-delete-comment (comment)
- "Delete the comment at point."
- (interactive (list (or (forge-comment-at-point)
- (user-error "There is no comment at point"))))
- (when (yes-or-no-p "Do you really want to delete the selected comment? ")
- (forge--delete-comment (forge-get-repository t) comment)))
-
-;;; 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" t)))
- (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)
- (magit-refresh))))
-
-(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))
- (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 (forge--url-equal url (format "git@%s:%s.git" host fork))
- (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" t)))
- (magit-checkout (forge--branch-pullreq (forge-get-pullreq pullreq))))
-
-;;;###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" t)))
- (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)
- (with-slots (number head-ref) pullreq
- (let ((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 ((`(,id ,name ,face ,description)
- (forge-read-mark "Edit mark")))
- (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))
-
-(defun forge-read-mark (prompt)
- "Read a topic. Return (ID NAME FACE DESCRIPTION)."
- (let* ((marks (forge-sql [:select [id name face description] :from mark]))
- (name (completing-read prompt (mapcar #'cadr marks) nil t)))
- (--first (equal (cadr it) name) marks)))
-
-(defun forge-read-marks (prompt &optional topic)
- "Read multiple mark names and return the respective ids."
- (let ((marks (forge-sql [:select [name id] :from mark]))
- (crm-separator ","))
- (--map (cadr (assoc it marks))
- (magit-completing-read-multiple
- prompt (mapcar #'car marks) nil t
- (and topic
- (mapconcat #'car (closql--iref topic 'marks) ","))))))
-
-(defun forge-toggle-mark (mark)
- "Toggle MARK for the current topic."
- (if-let ((topic (forge-current-topic)))
- (let* ((value (mapcar #'car (closql--iref topic 'marks)))
- (value (if (member mark value)
- (delete mark value)
- (cons mark value)))
- (marks (forge-sql [:select [name id] :from mark])))
- (oset topic marks (--map (cadr (assoc it marks)) value))
- (magit-refresh))
- (user-error "There is no topic at point")))
-
-;;; Fork
-
-;;;###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"))))
-
-;;; Misc
-
-(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)))
-
-;;;###autoload
-(defun forge-list-notifications ()
- "List notifications."
- (interactive)
- (forge-notifications-setup-buffer))
-
-(transient-define-suffix forge-toggle-display-in-status-buffer ()
- "Toggle whether to display topics in the current status buffer."
- :description (lambda ()
- (if forge-display-in-status-buffer
- "hide all topics"
- "display topics"))
- (interactive)
- (setq forge-display-in-status-buffer (not forge-display-in-status-buffer))
- (magit-refresh))
-
-(transient-define-suffix forge-toggle-closed-visibility ()
- "Toggle whether to display recently closed topics.
-This only affect the current status buffer."
- :description (lambda ()
- (if (or (atom forge-topic-list-limit)
- (> (cdr forge-topic-list-limit) 0))
- "hide closed topics"
- "display recently closed topics"))
- :inapt-if-not (lambda () forge-display-in-status-buffer)
- (interactive)
- (magit-repository-local-delete (list 'forge-ls-recent-topics 'issue))
- (magit-repository-local-delete (list 'forge-ls-recent-topics 'pullreq))
- (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))))
- (magit-refresh))
-
-(transient-define-infix forge-forge.graphqlItemLimit ()
- "Change the maximum number of GraphQL entities to pull at once."
- :class 'magit--git-variable
- :variable "forge.graphqlItemLimit"
- :reader #'read-string
- :default (lambda () (number-to-string ghub-graphql-items-per-request)))
-
-;;;###autoload
-(defun 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."
- (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)))))
-
-;;;###autoload
-(defun forge-add-repository (url)
- "Add a repository to the database.
-Offer to either pull topics (now and in the future) or to only
-pull individual topics when the user invokes `forge-pull-topic'."
- (declare (interactive-only t))
- (interactive
- (let ((str (magit-read-string-ns
- "Add repository to database (url or name)"
- (and-let* ((repo (forge-get-repository 'stub))
- (remote (oref repo remote)))
- (magit-git-string "remote" "get-url" remote)))))
- (if (string-match-p "\\(://\\|@\\)" str)
- (list str)
- (list (magit-clone--name-to-url str)))))
- (if (forge-get-repository url nil 'full)
- (user-error "%s is already tracked in Forge database" url)
- (let ((repo (forge-get-repository url nil 'create)))
- (oset repo sparse-p nil)
- (magit-read-char-case "Pull " nil
- (?a "[a]ll topics"
- (forge-pull repo))
- (?i "[i]ndividual topics (useful for casual contributors)"
- (oset repo selective-p t)
- (forge--pull repo nil))))))
-
-;;;###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))
-
-;;;###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" t)
- (if (forge--childp (forge-get-repository t) '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-remove-repository (host owner name)
- "Remove a repository from the database."
- (interactive
- (pcase-let ((`(,githost ,owner ,name)
- (forge-read-repository "Remove repository from db")))
- (if (yes-or-no-p
- (format "Do you really want to remove \"%s/%s @%s\" from the db? "
- owner name githost))
- (list githost owner name)
- (user-error "Abort"))))
- (closql-delete (forge-get-repository (list host owner name)))
- (magit-refresh))
-
-;;;###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))
- (magit-refresh)))
-
-;;;###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 'full))
- (_ (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)
- (magit-refresh)
- (message "Renaming default branch...done")))
-
-;;;###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)
- (magit-refresh)))
-
-(defun forge-enable-sql-logging ()
- "Enable logging Forge's SQL queries."
- (interactive)
- (let ((db (forge-db)))
- (emacsql-enable-debugging db)
- (switch-to-buffer-other-window (emacsql-log-buffer (oref db connection)))))
-
-(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-2023 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-
-;; 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 '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 'owner eieio--known-slot-names)
- (cl-pushnew 'number 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)
- ("code.orgmode.org" "code.orgmode.org/api/v1"
- "code.orgmode.org" forge-gogs-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 ID CLASS).
-
-GITHOST is matched against the host part of Git remote urls
- using `forge--url-regexp' to identify the forge.
-APIHOST is the api endpoint of the forge's api.
-ID is used to identify the forge in the local database.
-CLASS is the class to be used for repository from the forge.
-
-GITHOST and APIHOST can be changed, but ID and CLASS are final.
-If you change ID, then the identity of every repository from
-that forge changes. If you change CLASS, then things start
-falling apart.
-
-There can be multiple elements that only differ in GITHOST.
-Among those, the canonical element should come first. Any
-elements that have the same APIHOST must also have the same
-ID, and vice-versa.
-
-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.
-
-* This variable does not account for the possibility that the
- git repository does not use the same address as the web
- interface. That is another historic accident and if many
- users are affected by it, we might have to fix it properly.
- If you would like that, comment on issue #532.
-
- For now a workaround has to be used. Assuming the web
- interface is available at \"example.com\" and the repository
- is at \"ssh.example.com\", use \"example.com\" as GITHOST and
- add something like this to \".gitconfig\":
-
- [url \"gitNOSPAMssh.example.com\"]
- insteadOf = gitNOSPAMexample.com"
- :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"))))
-
-(defcustom forge-pull-notifications nil
- "Whether `forge-pull' also fetches notifications.
-If this is nil, then `forge-pull-notifications' has to be used."
- :package-version '(forge . "0.2.0")
- :group 'forge
- :type 'boolean)
-
-;;; Core
-
-(defclass forge-object (closql-object) () :abstract t)
-
-(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.
-
-The DEMAND argument controls what to do when the object isn't
-stored in the database yet, or if it is marked as sparse. The
-valid values are:
-
-* `nil' If the repository is stored in the database then return
- it, even if it is sparse. Otherwise return nil.
-
-* `t' If the repository isn't stored in the database or if the
- object is sparse, then signal an error, informing the user
- that `this-command' cannot be run until the repository has
- been pulled.
-
-* `full' If the repository is stored in the database and the
- object isn't sparse, then return it. Otherwise return nil.
-
-* `stub' If the repository is stored in the database, then return
- it, regardless of whether it is sparse or not. Otherwise create
- a new object and return it, but do not store it in the database.
- In the latter case it is assumed that the caller does not need
- the `id' and `forge-id' slots whose value differ from what they
- would be if the object were retrieved from the database.
-
-* `create' This value is only intended to be used by commands
- that fetch data from the API. If the repository is stored in
- the database, then return that, regardless of whether the
- object is sparse or not. If the repository is not stored in the
- database, then make an API request to determine the ID used on
- the forge, derive our own ID from that, and store a new sparse
- object in the database and return it.
-
-If DEMAND is t, `stub' or `create', then also signal an error if
-the repository cannot be determined because there is no matching
-entry in `forge-alist'.
-
-Also update the object's `apihost', `githost' and `remote' slots
-according to the respective entry in `forge-alist' and the REMOTE
-argument.
-
-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.")
-
-(cl-defgeneric forge-get-url (obj)
- "Return the URL for a forge object.")
-
-(cl-defgeneric forge-browse (obj)
- "Visit the URL corresponding to a forge object in a browser."
- (browse-url (forge-get-url obj)))
-
-(cl-defgeneric forge-visit (obj)
- "View a forge object in a separate buffer.")
-
-(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)
- "Return the database and forge ids for the specified CLASS object.")
-
-(cl-defmethod magit-section-ident-value ((obj forge-object))
- (oref obj id))
-
-;;; Utilities
-
-(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))))
-
-(defun forge--set-id-slot (repo object slot rows)
- (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))))
-
-(cl-defgeneric forge--format (object slot &optional spec))
-
-(cl-defmethod forge--format ((remote string) slot &optional spec)
- (if-let ((parts (forge--split-remote-url remote)))
- (forge--format
- (forge-get-repository 'stub remote) slot
- (pcase-let* ((`(,host ,owner ,name) parts)
- (path (if owner (concat owner "/" name) name)))
- `(,@spec
- (?h . ,host)
- (?o . ,owner)
- (?n . ,name)
- (?p . ,path)
- (?P . ,(string-replace "/" "%2F" path)))))
- (user-error "Cannot browse non-forge remote %s" remote)))
-
-(defun forge--url-regexp ()
- (concat "\\`\\(?:git://\\|"
- "[^/@]+@\\|"
- "\\(?:ssh\\|ssh\\+git\\|git\\+ssh\\)://\\(?:[^/@]+@\\)?\\|"
- "https?://\\(?:[^/@]+@\\)?\\)?"
- (regexp-opt (mapcar #'car forge-alist) t)
- "\\(?::[0-9]+\\)?"
- "\\(?:/\\|:/?\\)"
- "\\(.+?\\)"
- "\\(?:\\.git\\|/\\)?\\'"))
-
-(defun forge--split-remote-url (remote)
- (and-let* ((url (magit-git-string "remote" "get-url" remote)))
- (forge--split-url url)))
-
-(defun forge--split-url (url)
- (and (string-match (forge--url-regexp) url)
- (and-let* ((host (match-string 1 url))
- (path (match-string 2 url))
- (path (forge--split-url-path
- (nth 3 (assoc host forge-alist))
- path)))
- (cons host path))))
-
-(cl-defmethod forge--split-url-path
- ((_class (subclass forge-repository)) path)
- (and (string-match "\\`\\([^/]+\\)/\\([^/]+?\\)\\'" path)
- (list (match-string 1 path)
- (match-string 2 path))))
-
-(cl-defmethod forge--split-url-path
- ((_class (subclass forge-noapi-repository)) path)
- (and (string-match "\\`\\(?:~?\\(.+\\)/\\)?\\([^/]+?\\)\\'" path)
- (list (match-string 1 path)
- (match-string 2 path))))
-
-(defun forge--url-p (url)
- (save-match-data
- (and (string-match (forge--url-regexp) url)
- (nth 2 (assoc (match-string 1 url) forge-alist)))))
-
-(defun forge--forge-remote-p (remote)
- (and-let* ((url (magit-git-string "remote" "get-url" remote)))
- (forge--url-p url)))
-
-(defun forge--url-equal (urlA urlB)
- (or (equal urlA urlB)
- (save-match-data
- (let ((re (forge--url-regexp))
- hostA repoA hostB repoB)
- (and (when (string-match re urlA)
- (setq hostA (match-string 1 urlA))
- (setq repoA (match-string 2 urlA)))
- (when (string-match re urlB)
- (setq hostB (match-string 1 urlB))
- (setq repoB (match-string 2 urlB)))
- (equal repoA repoB)
- (equal (cl-caddr (assoc hostA forge-alist))
- (cl-caddr (assoc hostB forge-alist))))))))
-
-(cl-defmethod forge--format-resource ((object forge-object) resource)
- (save-match-data
- (setq resource
- (replace-regexp-in-string
- ":\\([^/]+\\)"
- (lambda (str)
- (let ((slot (intern (substring str 1))))
- (or (and-let*
- ((v (ignore-errors
- (cl-case 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)))
- (t (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)))
-
-;; This is a copy of `org-id-uuid'.
-(defun forge--uuid ()
- "Return string with random (version 4) UUID."
- (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-2023 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-
-;; 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-get-issue "forge-core")
-(declare-function forge-get-pullreq "forge-core")
-(declare-function forge--object-id "forge-core")
-
-(eval-when-compile
- (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 9)))
-
-(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)
-
-;;; Schemata
-
-(defconst forge--db-table-schemata
- '((repository
- [(class :not-null)
- (id :not-null :primary-key)
- forge-id
- forge
- owner
- name
- apihost
- githost
- remote
- sparse-p
- 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)])
-
- (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
- unread-p
- 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]
- (: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
- forge
- reason
- unread-p
- last-read
- updated
- title
- type
- topic
- url]
- (: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
- unread-p
- 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]
- (: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")))
- (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-2023 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-
-;; 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-2023 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-
-;; 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/*")))
-
-;;; Pull
-;;;; Repository
-
-(cl-defmethod forge--pull ((repo forge-github-repository) until
- &optional callback)
- (let ((buf (current-buffer))
- (dir default-directory)
- (selective-p (oref repo selective-p))
- (ghub-graphql-items-per-request
- (string-to-number
- (or (magit-get "forge.graphqlItemLimit") "100"))))
- (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 sparse-p nil))
- (forge--msg repo t t "Storing REPO")
- (cond
- (selective-p)
- (callback (funcall callback))
- (forge-pull-notifications
- (forge--pull-notifications (eieio-object-class repo)
- (oref repo githost)
- (lambda () (forge--git-fetch buf dir repo))))
- (t (forge--git-fetch buf dir repo))))
- `((issues-until . ,(forge--topics-until repo until 'issue))
- (pullRequests-until . ,(forge--topics-until repo until 'pullreq)))
- :host (oref repo apihost)
- :auth 'forge
- :sparse selective-p)))
-
-(cl-defmethod forge--pull-topic ((repo forge-github-repository)
- (topic forge-topic))
- (let ((buffer (current-buffer))
- (fetch #'ghub-fetch-issue)
- (update #'forge--update-issue)
- (errorback (lambda (err _headers _status _req)
- (when (equal (cdr (assq 'type (cadr err))) "NOT_FOUND")
- (forge--pull-topic
- repo (forge-pullreq :repository (oref repo id)
- :number (oref topic number)))))))
- (when (cl-typep topic 'forge-pullreq)
- (setq fetch #'ghub-fetch-pullreq)
- (setq update #'forge--update-pullreq)
- (setq errorback nil))
- (funcall
- fetch
- (oref repo owner)
- (oref repo name)
- (oref topic number)
- (lambda (data)
- (funcall update repo data nil)
- (with-current-buffer
- (if (buffer-live-p buffer) buffer (current-buffer))
- (magit-refresh)))
- nil
- :errorback errorback
- :host (oref repo apihost)
- :auth 'forge)))
-
-(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-issues ((repo forge-github-repository) data bump)
- (closql-with-transaction (forge-db)
- (mapc (lambda (e) (forge--update-issue repo e bump)) data)))
-
-(cl-defmethod forge--update-issue ((repo forge-github-repository) data bump)
- (closql-with-transaction (forge-db)
- (let-alist data
- (let* ((issue-id (forge--object-id 'forge-issue repo .number))
- (issue (or (forge-get-issue repo .number)
- (closql-insert
- (forge-db)
- (forge-issue :id issue-id
- :repository (oref repo id)
- :number .number)))))
- (oset issue id issue-id)
- (oset issue their-id .id)
- (oset issue state (pcase-exhaustive .state
- ("CLOSED" 'closed)
- ("OPEN" 'open)))
- (oset issue author .author.login)
- (oset issue title .title)
- (oset issue created .createdAt)
- (oset issue updated (cond (bump (or .updatedAt .createdAt))
- ((slot-boundp issue 'updated)
- (oref issue updated))
- (t "0")))
- (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))
- .databaseId ; Silence Emacs 25 byte-compiler.
- (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)))
- (when bump
- (forge--set-id-slot repo issue 'assignees .assignees)
- (unless (magit-get-boolean "forge.kludge-for-issue-294")
- (forge--set-id-slot repo issue 'labels .labels)))
- issue))))
-
-(cl-defmethod forge--update-pullreqs ((repo forge-github-repository) data bump)
- (closql-with-transaction (forge-db)
- (mapc (lambda (e) (forge--update-pullreq repo e bump)) data)))
-
-(cl-defmethod forge--update-pullreq ((repo forge-github-repository) data bump)
- (closql-with-transaction (forge-db)
- (let-alist data
- (let* ((pullreq-id (forge--object-id 'forge-pullreq repo .number))
- (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 state (pcase-exhaustive .state
- ("MERGED" 'merged)
- ("CLOSED" 'closed)
- ("OPEN" 'open)))
- (oset pullreq author .author.login)
- (oset pullreq title .title)
- (oset pullreq created .createdAt)
- (oset pullreq updated (cond (bump (or .updatedAt .createdAt))
- ((slot-boundp pullreq 'updated)
- (oref pullreq updated))
- (t "0")))
- (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))
- .databaseId ; Silence Emacs 25 byte-compiler.
- (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)))
- (when bump
- (forge--set-id-slot repo pullreq 'assignees .assignees)
- (forge--set-id-slot repo pullreq 'review-requests
- (--map (cdr (cadr (car it)))
- .reviewRequests))
- (unless (magit-get-boolean "forge.kludge-for-issue-294")
- (forge--set-id-slot repo pullreq 'labels .labels)))
- pullreq))))
-
-(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)))))
-
-;;;; 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 (assoc githost forge-alist)))
- (unless spec
- (error "No entry for %S in forge-alist" githost))
- (forge--msg nil t nil "Pulling notifications")
- (pcase-let*
- ((`(,_ ,apihost ,forge ,_) spec)
- (notifs (-keep (lambda (data)
- ;; Github may return notifications for repos
- ;; the user no longer has access to. Trying
- ;; to retrieve information for such a repo
- ;; leads to an error, which we suppress. See #164.
- (with-demoted-errors "forge--pull-notifications: %S"
- (forge--ghub-massage-notification
- data forge githost)))
- (forge--ghub-get nil "/notifications"
- '((all . t))
- :host apihost :unpaginate t)))
- (groups (-partition-all 50 notifs))
- (pages (length groups))
- (page 0)
- (result nil))
- (cl-labels
- ((cb (&optional data _headers _status _req)
- (when data
- (setq result (nconc result (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 (-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")
- (closql-with-transaction (forge-db)
- (forge-sql [:delete-from notification
- :where (= forge $s1)] forge)
- (pcase-dolist (`(,key ,repo ,query ,obj) notifs)
- (closql-insert (forge-db) obj)
- (forge--zap-repository-cache (forge-get-repository obj))
- (when query
- (oset (funcall (if (eq (oref obj type) 'issue)
- #'forge--update-issue
- #'forge--update-pullreq)
- repo (cdr (cadr (assq key result))) nil)
- unread-p (oref obj unread-p)))))
- (forge--msg nil t t "Storing notifications")
- (when callback
- (funcall callback)))))
- (cb)))))
-
-(defun forge--ghub-massage-notification (data forge 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 'create))
- (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 repo
- `((,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)))
- ))))
- (forge-notification
- :id id
- :thread-id .id
- :repository repoid
- :forge forge
- :reason (intern (downcase .reason))
- :unread-p .unread
- :last-read .last_read_at
- :updated .updated_at
- :title .subject.title
- :type type
- :topic number
- :url .subject.url)))))))
-
-(cl-defmethod forge-topic-mark-read ((_ forge-github-repository) topic)
- (when (oref topic unread-p)
- (oset topic unread-p nil)
- (when-let ((notif (forge-get-notification topic)))
- (oset topic unread-p nil)
- (forge--ghub-patch notif "/notifications/threads/:thread-id"))))
-
-;;;; 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 'create)))
- (and (oref repo sparse-p)
- (list repo))))
- names))
- cb)
- (setq cb (lambda ()
- (when-let ((repo (pop repos)))
- (message "Adding %s..." (oref repo name))
- (forge--pull repo nil cb))))
- (funcall cb)))
-
-;;; Mutations
-
-(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-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--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)))
-
-(cl-defmethod forge--set-topic-state
- ((_repo forge-github-repository) topic)
- (forge--ghub-patch topic
- "/repos/:owner/:repo/issues/:number"
- `((state . ,(cl-ecase (oref topic state)
- (closed "OPEN")
- (open "CLOSED"))))
- :callback (forge--set-field-callback)))
-
-(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)
- (when (buffer-live-p buffer)
- (with-current-buffer buffer
- (magit-refresh-buffer))))))))
-
-(cl-defmethod forge--set-topic-milestone
- ((repo forge-github-repository) topic milestone)
- (forge--ghub-patch topic
- "/repos/:owner/:repo/issues/:number"
- `((milestone
- . ,(caar (forge-sql [:select [number]
- :from milestone
- :where (and (= repository $s1)
- (= title $s2))]
- (oref repo id)
- milestone))))
- :callback (forge--set-field-callback)))
-
-(cl-defmethod forge--set-topic-labels
- ((_repo forge-github-repository) topic labels)
- (forge--ghub-put topic "/repos/:owner/:repo/issues/:number/labels" nil
- :payload labels
- :callback (forge--set-field-callback)))
-
-(cl-defmethod forge--set-topic-assignees
- ((_repo forge-github-repository) topic assignees)
- (let ((value (mapcar #'car (closql--iref topic 'assignees))))
- (when-let ((add (cl-set-difference assignees value :test #'equal)))
- (forge--ghub-post topic "/repos/:owner/:repo/issues/:number/assignees"
- `((assignees . ,add))))
- (when-let ((remove (cl-set-difference value assignees :test #'equal)))
- (forge--ghub-delete topic "/repos/:owner/:repo/issues/:number/assignees"
- `((assignees . ,remove)))))
- (forge-pull))
-
-(cl-defmethod forge--set-topic-review-requests
- ((_repo forge-github-repository) topic reviewers)
- (let ((value (mapcar #'car (closql--iref topic 'review-requests))))
- (when-let ((add (cl-set-difference reviewers value :test #'equal)))
- (forge--ghub-post topic
- "/repos/:owner/:repo/pulls/:number/requested_reviewers"
- `((reviewers . ,add))))
- (when-let ((remove (cl-set-difference value reviewers :test #'equal)))
- (forge--ghub-delete topic
- "/repos/:owner/:repo/pulls/:number/requested_reviewers"
- `((reviewers . ,remove)))))
- (forge-pull))
-
-(cl-defmethod forge--delete-comment
- ((_repo forge-github-repository) post)
- (forge--ghub-delete post "/repos/:owner/:repo/issues/comments/:number")
- (closql-delete post)
- (magit-refresh))
-
-(cl-defmethod forge--topic-templates ((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-templates ((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))))))
-
-;;; Utilities
-
-(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-2023 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-
-;; 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) until)
- (let ((cb (let ((buf (and (derived-mode-p 'magit-mode)
- (current-buffer)))
- (dir default-directory)
- (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 until))
- ((and .merge_requests_enabled
- (not (assq 'pullreqs val)))
- (forge--fetch-pullreqs repo cb until))
- (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 sparse-p nil))
- (forge--msg repo t t "Storing REPO")
- (unless (oref repo selective-p)
- (forge--git-fetch buf dir repo)))))))))
- (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)))
-
-(cl-defmethod forge--split-url-path
- ((_class (subclass forge-gitlab-repository)) path)
- (and (string-match "\\`\\(?:~?\\(.+\\)/\\)?\\([^/]+?\\)\\'" path)
- (list (match-string 1 path)
- (match-string 2 path))))
-
-;;;; Issues
-
-(cl-defmethod forge--fetch-issues ((repo forge-gitlab-repository) callback until)
- (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 (forge--topics-until repo until 'issue)))
- `((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
- :repository (oref repo id)
- :state (pcase-exhaustive .state
- ("closed" 'closed)
- ("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 slots
- ;; 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))
- .body .id ; Silence Emacs 25 byte-compiler.
- (dolist (c .notes)
- (let-alist c
- (let ((post
- (forge-issue-post
- :id (forge--object-id issue-id .id)
- :issue issue-id
- :number .id
- :author .author.username
- :created .created_at
- :updated .updated_at
- :body (forge--sanitize-string .body))))
- (closql-insert (forge-db) post t))))))))
-
-;;;; Pullreqs
-
-(cl-defmethod forge--fetch-pullreqs ((repo forge-gitlab-repository) callback until)
- (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 (forge--topics-until repo until 'pullreq)))
- `((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
- :repository (oref repo id)
- :state (pcase-exhaustive .state
- ("merged" 'merged)
- ("closed" 'closed)
- ("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))
- .body .id ; Silence Emacs 25 byte-compiler.
- (dolist (c .notes)
- (let-alist c
- (let ((post
- (forge-pullreq-post
- :id (forge--object-id pullreq-id .id)
- :pullreq pullreq-id
- :number .id
- :author .author.username
- :created .created_at
- :updated .updated_at
- :body (forge--sanitize-string .body))))
- (closql-insert (forge-db) post t))))))))
-
-;;;; 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-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-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-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)))
-
-(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)
- (forge--set-topic-field repo topic 'state_event
- (cl-ecase (oref topic state)
- (closed "reopen")
- (open "close"))))
-
-(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)
- (when (buffer-live-p buffer)
- (with-current-buffer buffer
- (magit-refresh-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)
- (magit-refresh))
-
-(cl-defmethod forge--topic-templates ((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-templates ((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))))))
-
-;;; Utilities
-
-(cl-defmethod forge--topic-type-prefix ((_repo forge-gitlab-repository) type)
- (if (eq type 'pullreq) "!" "#"))
-
-(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-2023 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-
-;; 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-2023 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-
-;; 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)
- (closed :initarg :closed)
- (unread-p :initarg :unread-p :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)
- ))
-
-(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
-
-(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 t)))
- (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))
-
-(cl-defmethod forge-ls-issues ((repo forge-repository) &optional type select)
- (forge-ls-topics repo 'forge-issue type select))
-
-;;; Utilities
-
-(defun forge-read-issue (prompt &optional type)
- (when (eq type t)
- (setq type (if current-prefix-arg nil 'open)))
- (let* ((default (forge-current-issue))
- (repo (forge-get-repository (or default t)))
- (choices (mapcar
- (apply-partially #'forge--topic-format-choice repo)
- (forge-ls-issues repo type [number title id class]))))
- (cdr (assoc (magit-completing-read
- prompt choices nil nil nil nil
- (and default
- (setq default (forge--topic-format-choice default))
- (member default choices)
- (car default)))
- choices))))
-
-(cl-defmethod forge-get-url ((issue forge-issue))
- (forge--format issue 'issue-url-format))
-
-(defun forge--issue-by-forge-short-link-at-point ()
- (forge--topic-by-forge-short-link-at-point '("#") #'forge-get-issue))
-
-;;; Sections
-
-(defun forge-current-issue ()
- (or (forge-issue-at-point)
- (and (derived-mode-p 'forge-topic-mode)
- (forge-issue-p forge-buffer-topic)
- forge-buffer-topic)
- (and (derived-mode-p 'forge-topic-list-mode)
- (let ((topic (forge-get-topic (tabulated-list-get-id))))
- (and (forge-issue-p topic)
- topic)))))
-
-(defun forge-issue-at-point ()
- (or (magit-section-value-if 'issue)
- (and-let* ((post (magit-section-value-if 'post)))
- (cond ((forge-issue-p post)
- post)
- ((forge-issue-post-p post)
- (forge-get-issue post))))
- (forge--issue-by-forge-short-link-at-point)))
-
-(defvar-keymap forge-issues-section-map
- "<remap> <magit-browse-thing>" #'forge-browse-issues
- "<remap> <magit-visit-thing>" #'forge-list-issues
- "C-c C-n" #'forge-create-issue)
-
-(defvar-keymap forge-issue-section-map
- "<remap> <magit-browse-thing>" #'forge-browse-issue
- "<remap> <magit-visit-thing>" #'forge-visit-issue)
-
-(defun forge-insert-issues ()
- "Insert a list of mostly recent and/or open issues.
-Also see option `forge-topic-list-limit'."
- (when (and forge-display-in-status-buffer (forge-db t))
- (when-let ((repo (forge-get-repository nil)))
- (when (and (not (oref repo sparse-p))
- (or (not (slot-boundp repo 'issues-p)) ; temporary KLUDGE
- (oref repo issues-p)))
- (forge-insert-topics "Issues"
- (forge-ls-recent-topics repo 'issue)
- (forge--topic-type-prefix repo 'issue))))))
-
-(defun forge-insert-assigned-issues ()
- "Insert a list of open issues that are assigned to you."
- (when forge-display-in-status-buffer
- (when-let ((repo (forge-get-repository nil)))
- (unless (oref repo sparse-p)
- (forge-insert-topics "Assigned issues"
- (forge--ls-assigned-issues repo)
- (forge--topic-type-prefix repo 'issue))))))
-
-(defun forge--ls-assigned-issues (repo)
- (mapcar (lambda (row)
- (closql--remake-instance 'forge-issue (forge-db) row))
- (forge-sql
- [:select $i1 :from [issue issue_assignee assignee]
- :where (and (= issue_assignee:issue issue:id)
- (= issue_assignee:id assignee:id)
- (= issue:repository $s2)
- (= assignee:login $s3)
- (isnull issue:closed))
- :order-by [(desc updated)]]
- (vconcat (closql--table-columns (forge-db) 'issue t))
- (oref repo id)
- (ghub--username repo))))
-
-(defun forge-insert-authored-issues ()
- "Insert a list of open issues that are authored to you."
- (when forge-display-in-status-buffer
- (when-let ((repo (forge-get-repository nil)))
- (unless (oref repo sparse-p)
- (forge-insert-topics "Authored issues"
- (forge--ls-authored-issues repo)
- (forge--topic-type-prefix repo 'issue))))))
-
-(defun forge--ls-authored-issues (repo)
- (mapcar (lambda (row)
- (closql--remake-instance 'forge-issue (forge-db) row))
- (forge-sql
- [:select $i1 :from [issue]
- :where (and (= issue:repository $s2)
- (= issue:author $s3)
- (isnull issue:closed))
- :order-by [(desc updated)]]
- (vconcat (closql--table-columns (forge-db) 'issue t))
- (oref repo id)
- (ghub--username repo))))
-
-;;; _
-(provide 'forge-issue)
-;;; forge-issue.el ends here
+++ /dev/null
-;;; forge-list.el --- Tabulated-list interface -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2023 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-
-;; 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)
-
-(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))
-
-(defvar forge-topic-list-columns
- '(("#" 5 forge-topic-list-sort-by-number (:right-align t) number nil)
- ("Title" 35 t nil title nil)
- ))
-
-(defvar forge-global-topic-list-columns
- '(("Owner" 15 t nil repository:owner nil)
- ("Name" 20 t nil repository:name nil)
- ("#" 5 forge-topic-list-sort-by-number (:right-align t) number nil)
- ("Title" 35 t nil title nil)
- ))
-
-(defvar forge-repository-list-columns
- '(("Owner" 20 t nil owner nil)
- ("Name" 20 t nil name nil)
- ("N" 1 t nil sparse-p nil)
- ("S" 1 t nil selective-p nil)
- ("Worktree" 99 t nil worktree nil)
- ))
-
-(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)))
-
-(define-obsolete-variable-alias 'forge-owned-blacklist
- 'forge-owned-ignored "Forge 3.0.0")
-
-(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")))
-
-;;; Variables
-
-(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)
-
-;;; Modes
-;;;; Topics
-
-(defvar-keymap forge-topic-list-mode-map
- :doc "Local keymap for Forge-Topic-List mode buffers."
- :parent tabulated-list-mode-map
- "RET" #'forge-visit-topic
- "<return>" #'forge-visit-topic
- "o" #'forge-browse-topic
- "'" #'forge-dispatch
- "?" #'magit-dispatch)
-
-(define-derived-mode forge-topic-list-mode tabulated-list-mode
- "Issues"
- "Major mode for browsing a list of topics."
- (setq-local x-stretch-cursor nil)
- (setq tabulated-list-padding 0)
- (setq tabulated-list-sort-key (cons "#" nil)))
-
-(define-derived-mode forge-issue-list-mode forge-topic-list-mode
- "Issues"
- "Major mode for browsing a list of issues.")
-
-(define-derived-mode forge-pullreq-list-mode forge-topic-list-mode
- "Pull-Requests"
- "Major mode for browsing a list of pull-requests.")
-
-(defun forge-topic-list-setup (mode id buffer-name columns fn)
- (declare (indent 4))
- (let* ((repo (forge-get-repository (list :id id)))
- (topdir (magit-toplevel)))
- (with-current-buffer
- (get-buffer-create
- (or buffer-name
- (format "*%s: %s/%s*"
- (substring (symbol-name mode) 0 -5)
- (oref repo owner)
- (oref repo name))))
- (setq forge--tabulated-list-columns (or columns forge-topic-list-columns))
- (setq forge--tabulated-list-query fn)
- (setq forge-buffer-repository repo)
- (when topdir
- (setq default-directory topdir))
- (cl-letf (((symbol-function #'tabulated-list-revert) #'ignore)) ; see #229
- (funcall mode))
- (forge-topic-list-refresh)
- (add-hook 'tabulated-list-revert-hook
- #'forge-topic-list-refresh nil t)
- (tabulated-list-init-header)
- (tabulated-list-print)
- (switch-to-buffer (current-buffer)))))
-
-(defun forge-topic-list-refresh ()
- (setq tabulated-list-format
- (vconcat (--map `(,@(-take 3 it)
- ,@(-flatten (nth 3 it)))
- forge--tabulated-list-columns)))
- (tabulated-list-init-header)
- (setq tabulated-list-entries
- (mapcar #'forge--tablist-format-entry
- (funcall forge--tabulated-list-query))))
-
-;;;; Repository
-
-(defvar-keymap forge-repository-list-mode-map
- :doc "Local keymap for Forge-Repository-List mode buffers."
- :parent tabulated-list-mode-map
- "RET" #'forge-visit-repository
- "<return>" #'forge-visit-repository
- "o" #'forge-browse-repository
- "'" #'forge-dispatch
- "?" #'magit-dispatch)
-
-(define-derived-mode forge-repository-list-mode tabulated-list-mode
- "Repositories"
- "Major mode for browsing a list of repositories."
- (setq-local x-stretch-cursor nil)
- (setq forge--tabulated-list-columns forge-repository-list-columns)
- (setq tabulated-list-padding 0)
- (setq tabulated-list-sort-key (cons "Owner" nil))
- (setq tabulated-list-format
- (vconcat (--map `(,@(-take 3 it)
- ,@(-flatten (nth 3 it)))
- forge-repository-list-columns)))
- (tabulated-list-init-header))
-
-(defun forge-repository-list-setup (fn buf)
- (with-current-buffer (get-buffer-create buf)
- (cl-letf (((symbol-function #'tabulated-list-revert) #'ignore)) ; see #229
- (forge-repository-list-mode))
- (funcall fn)
- (add-hook 'tabulated-list-revert-hook fn nil t)
- (tabulated-list-print)
- (switch-to-buffer (current-buffer))))
-
-(defun forge-repository-list-refresh ()
- (setq tabulated-list-entries
- (mapcar #'forge--tablist-format-entry
- (forge-sql [:select $i1 :from repository
- :order-by [(asc owner) (asc name)]]
- (forge--tablist-columns-vector)))))
-
-(defun forge-repository-list-owned-refresh ()
- (setq tabulated-list-entries
- (mapcar #'forge--tablist-format-entry
- (forge-sql [:select $i1 :from repository
- :where (and (in owner $v2)
- (not (in name $v3)))
- :order-by [(asc owner) (asc name)]]
- (forge--tablist-columns-vector)
- (vconcat (mapcar #'car forge-owned-accounts))
- (vconcat forge-owned-ignored)))))
-
-;;; Commands
-;;;; Topic
-
-;;;###autoload
-(defun forge-list-topics (id)
- "List topics of the current repository in a separate buffer."
- (interactive (list (oref (forge-get-repository t) id)))
- (forge-topic-list-setup #'forge-topic-list-mode id nil nil
- (lambda ()
- (forge-sql [:select $i1 :from issue :where (= repository $s2) :union
- :select $i1 :from pullreq :where (= repository $s2)]
- (forge--tablist-columns-vector)
- id))))
-
-;;;; Issue
-
-;;;###autoload
-(defun forge-list-issues (id)
- "List issues of the current repository in a separate buffer."
- (interactive (list (oref (forge-get-repository t) id)))
- (forge-topic-list-setup #'forge-issue-list-mode id nil nil
- (lambda ()
- (forge-sql [:select $i1 :from issue :where (= repository $s2)]
- (forge--tablist-columns-vector)
- id))))
-
-;;;###autoload
-(defun forge-list-labeled-issues (id label)
- "List issues of the current repository that have LABEL.
-List them in a separate buffer."
- (interactive (list (oref (forge-get-repository t) id)
- (magit-completing-read
- "Label"
- (mapcar #'cadr (oref (forge-get-repository t) labels))
- nil t)))
- (forge-topic-list-setup #'forge-issue-list-mode id nil nil
- (lambda ()
- (forge-sql [:select $i1 :from [issue issue_label label]
- :where (and (= issue_label:issue issue:id)
- (= issue_label:id label:id)
- (= issue:repository $s2)
- (= label:name $s3)
- (isnull issue:closed))
- :order-by [(desc updated)]]
- (forge--tablist-columns-vector 'issue)
- id label))))
-
-;;;###autoload
-(defun forge-list-assigned-issues (id)
- "List issues of the current repository that are assigned to you.
-List them in a separate buffer."
- (interactive (list (oref (forge-get-repository t) id)))
- (forge-topic-list-setup #'forge-issue-list-mode id nil nil
- (lambda ()
- (forge-sql [:select $i1 :from [issue issue_assignee assignee]
- :where (and (= issue_assignee:issue issue:id)
- (= issue_assignee:id assignee:id)
- (= issue:repository $s2)
- (= assignee:login $s3)
- (isnull issue:closed))
- :order-by [(desc updated)]]
- (forge--tablist-columns-vector 'issue)
- id (ghub--username (forge-get-repository (list :id id)))))))
-
-;;;###autoload
-(defun 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."
- (interactive)
- (forge-topic-list-setup #'forge-issue-list-mode nil "My issues"
- forge-global-topic-list-columns
- (lambda ()
- (forge-sql [:select $i1 :from [issue repository]
- :where (and (= issue:repository repository:id)
- (in repository:owner $v2)
- (not (in repository:name $v3))
- (isnull issue:closed))
- :order-by [(asc repository:owner)
- (asc repository:name)
- (desc issue:number)]]
- (forge--tablist-columns-vector 'issue)
- (vconcat (mapcar #'car forge-owned-accounts))
- (vconcat forge-owned-ignored)))))
-
-;;;; Pullreq
-
-;;;###autoload
-(defun forge-list-pullreqs (id)
- "List pull-requests of the current repository in a separate buffer."
- (interactive (list (oref (forge-get-repository t) id)))
- (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil
- (lambda ()
- (forge-sql [:select $i1 :from pullreq :where (= repository $s2)]
- (forge--tablist-columns-vector)
- id))))
-
-;;;###autoload
-(defun forge-list-labeled-pullreqs (id label)
- "List pull-requests of the current repository that have LABEL.
-List them in a separate buffer."
- (interactive (list (oref (forge-get-repository t) id)
- (magit-completing-read
- "Label"
- (mapcar #'cadr (oref (forge-get-repository t) labels))
- nil t)))
- (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil
- (lambda ()
- (forge-sql [:select $i1 :from [pullreq pullreq_label label]
- :where (and (= pullreq_label:pullreq pullreq:id)
- (= pullreq_label:id label:id)
- (= pullreq:repository $s2)
- (= label:name $s3)
- (isnull pullreq:closed))
- :order-by [(desc updated)]]
- (forge--tablist-columns-vector 'pullreq)
- id label))))
-
-;;;###autoload
-(defun forge-list-assigned-pullreqs (id)
- "List pull-requests of the current repository that are assigned to you.
-List them in a separate buffer."
- (interactive (list (oref (forge-get-repository t) id)))
- (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil
- (lambda ()
- (forge-sql [:select $i1 :from [pullreq pullreq_assignee assignee]
- :where (and (= pullreq_assignee:pullreq pullreq:id)
- (= pullreq_assignee:id assignee:id)
- (= pullreq:repository $s2)
- (= assignee:login $s3)
- (isnull pullreq:closed))
- :order-by [(desc updated)]]
- (forge--tablist-columns-vector 'pullreq)
- id (ghub--username (forge-get-repository (list :id id)))))))
-
-;;;###autoload
-(defun forge-list-requested-reviews (id)
- "List pull-requests of the current repository that are awaiting your review.
-List them in a separate buffer."
- (interactive (list (oref (forge-get-repository t) id)))
- (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil
- (lambda ()
- (forge-sql [:select $i1 :from [pullreq pullreq_review_request assignee]
- :where (and (= pullreq_review_request:pullreq pullreq:id)
- (= pullreq_review_request:id assignee:id)
- (= pullreq:repository $s2)
- (= assignee:login $s3)
- (isnull pullreq:closed))
- :order-by [(desc updated)]]
- (forge--tablist-columns-vector 'pullreq)
- id (ghub--username (forge-get-repository (list :id id)))))))
-
-;;;###autoload
-(defun 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."
- (interactive)
- (forge-topic-list-setup #'forge-pullreq-list-mode nil "My pullreqs"
- forge-global-topic-list-columns
- (lambda ()
- (forge-sql [:select $i1 :from [pullreq repository]
- :where (and (= pullreq:repository repository:id)
- (in repository:owner $v2)
- (not (in repository:name $v3))
- (isnull pullreq:closed))
- :order-by [(asc repository:owner)
- (asc repository:name)
- (desc pullreq:number)]]
- (forge--tablist-columns-vector 'pullreq)
- (vconcat (mapcar #'car forge-owned-accounts))
- (vconcat forge-owned-ignored)))))
-
-;;;###autoload
-(defun forge-list-authored-pullreqs (id)
- "List open pull-requests of the current repository that are authored by you.
-List them in a separate buffer."
- (interactive (list (oref (forge-get-repository t) id)))
- (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil
- (lambda ()
- (forge-sql [:select $i1 :from [pullreq]
- :where (and (= pullreq:repository $s2)
- (= pullreq:author $s3)
- (isnull pullreq:closed))
- :order-by [(desc updated)]]
- (forge--tablist-columns-vector 'pullreq)
- id (ghub--username (forge-get-repository (list :id id)))))))
-
-;;;###autoload
-(defun forge-list-authored-issues (id)
- "List open issues from the current repository that are authored by you.
-List them in a separate buffer."
- (interactive (list (oref (forge-get-repository t) id)))
- (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil
- (lambda ()
- (forge-sql [:select $i1 :from [issue]
- :where (and (= issue:repository $s2)
- (= issue:author $s3)
- (isnull issue:closed))
- :order-by [(desc updated)]]
- (forge--tablist-columns-vector 'issue)
- id (ghub--username (forge-get-repository (list :id id)))))))
-
-;;;; Repository
-
-;;;###autoload
-(defun forge-list-repositories ()
- "List known repositories in a separate buffer.
-Here \"known\" means that an entry exists in the local database."
- (interactive)
- (forge-repository-list-setup #'forge-repository-list-refresh
- "*Forge Repositories*"))
-
-;;;###autoload
-(defun 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."
- (interactive)
- (forge-repository-list-setup #'forge-repository-list-owned-refresh
- "*Forge Owned Repositories*"))
-
-;;; Internal
-
-(defun forge-topic-list-sort-by-number (a b)
- "Sort the `tabulated-list-entries' by topic number.
-This assumes that `number' is the first column, otherwise
-it silently fails."
- (ignore-errors
- (> (read (aref (cadr a) 0))
- (read (aref (cadr b) 0)))))
-
-(defun forge--tablist-columns-vector (&optional table)
- (let ((columns (cons 'id (--map (nth 4 it) forge--tabulated-list-columns))))
- (vconcat (if table
- (let ((table (symbol-name table)))
- (--map (let ((col (symbol-name it)))
- (if (string-search ":" col)
- it
- (intern (concat table ":" col))))
- columns))
- columns))))
-
-(defun forge--tablist-format-entry (row)
- (list (car row)
- (vconcat
- (cl-mapcar (lambda (val col)
- (if-let ((pp (nth 5 col)))
- (funcall pp val)
- (if val (format "%s" val) "")))
- (cdr row)
- forge--tabulated-list-columns))))
-
-;;; _
-(provide 'forge-list)
-;;; forge-list.el ends here
+++ /dev/null
-;;; forge-notify.el --- Notify support -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2023 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-
-;; 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)
-
-;;; 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)
- (forge :initarg :forge)
- (reason :initarg :reason)
- (unread-p :initarg :unread-p)
- (last-read :initarg :last-read)
- (updated :initarg :updated)
- (title :initarg :title)
- (type :initarg :type)
- (topic :initarg :topic)
- (url :initarg :url)))
-
-;;; Core
-
-(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-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)))
-
-;;; Utilities
-
-(cl-defmethod forge-get-url ((notify forge-notification))
- (oref notify url))
-
-;;; Mode
-
-(defvar-keymap forge-notifications-mode-map
- :doc "Keymap for `forge-notifications-mode'."
- :parent magit-mode-map)
-
-(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 ()
- ;; There should only ever be one such buffer.
- (cl-letf (((symbol-function 'magit-get-mode-buffer)
- (lambda (&rest _)
- (get-buffer-create "*forge-notifications*"))))
- (magit-setup-buffer #'forge-notifications-mode)))
-
-(defun forge-notifications-refresh-buffer ()
- (forge-insert-notifications))
-
-;;; Utilities
-
-(defun forge--list-notifications-all ()
- (closql-query (forge-db) nil nil 'forge-notification))
-
-(defun forge--list-notifications-unread ()
- (mapcar (lambda (row)
- (closql--remake-instance 'forge-notification (forge-db) row))
- (forge-sql [:select * :from notification
- :where (notnull unread-p)
- :order-by [(desc id)]])))
-
-;;; Sections
-
-;; The double-prefix is necessary due to a limitation of magit-insert-section.
-(defvar-keymap forge-forge-repo-section-map
- "<remap> <magit-browse-thing>" #'forge-browse-repository
- "<remap> <magit-visit-thing>" #'forge-visit-repository)
-
-(defun forge-insert-notifications ()
- (when-let ((ns (forge--list-notifications-all)))
- (magit-insert-section (notifications)
- (magit-insert-heading "Notifications:")
- (pcase-dolist (`(,_ . ,ns) (--group-by (oref it repository) ns))
- (let ((repo (forge-get-repository (car ns))))
- (magit-insert-section (forge-repo repo t)
- (magit-insert-heading
- (concat (propertize (format "%s/%s"
- (oref repo owner)
- (oref repo name))
- 'font-lock-face 'bold)
- (format " (%s)" (length ns))))
- (magit-insert-section-body
- (dolist (notify ns)
- (with-slots (type topic title url unread-p) notify
- (pcase type
- ('issue
- (forge-insert-topic (forge-get-issue repo topic)))
- ('pullreq
- (forge-insert-topic (forge-get-pullreq repo topic)))
- ('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 unread-p
- '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 notify)
- (insert (propertize (format "(%s) %s\n" type title)
- 'font-lock-face 'error)))))))
- (insert ?\n))))))))
-
-;;; _
-(provide 'forge-notify)
-;;; forge-notify.el ends here
+++ /dev/null
-(define-package "forge" "20230505.926" "Access Git forges from Magit."
- '((emacs "25.1")
- (compat "29.1.3.4")
- (closql "20230407")
- (dash "2.19.1")
- (emacsql "20230409")
- (ghub "20220621")
- (let-alist "1.0.6")
- (magit "20230319")
- (markdown-mode "2.4")
- (transient "0.3.6")
- (yaml "0.3.5"))
- :commit "12428a702fc6c9b2b36896803e6022baafcad3cd" :authors
- '(("Jonas Bernoulli" . "jonasNOSPAMbernoul.li"))
- :maintainer
- '("Jonas Bernoulli" . "jonasNOSPAMbernoul.li")
- :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-2023 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-
-;; 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
-
-(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)))
-
-;;; Utilities
-
-(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-browse :after ((post forge-post))
- (oset (forge-get-topic post) unread-p nil))
-
-;;; Sections
-
-(defun forge-post-at-point ()
- (magit-section-value-if '(issue pullreq post)))
-
-(defun forge-comment-at-point ()
- (and (magit-section-value-if '(post))
- (let ((post (oref (magit-current-section) value)))
- (and (or (forge-pullreq-post-p post)
- (forge-issue-post-p post))
- post))))
-
-(defun forge-topic-at-point ()
- (or (magit-section-value-if '(issue pullreq))
- (and-let* ((branch (magit-branch-at-point))
- (n (magit-get "branch" branch "pullRequest")))
- (forge-get-pullreq (string-to-number n)))
- (and-let* ((rev (magit-commit-at-point)))
- (forge--pullreq-from-rev rev))
- (forge--issue-by-forge-short-link-at-point)
- (forge--pullreq-by-forge-short-link-at-point)))
-
-(defun forge-current-topic ()
- (or (forge-topic-at-point)
- (and (derived-mode-p 'forge-topic-mode)
- forge-buffer-topic)
- (and (derived-mode-p 'forge-topic-list-mode)
- (forge-get-topic (tabulated-list-get-id)))))
-
-(defun forge--pullreq-from-rev (rev)
- (and-let* ((repo (forge-get-repository nil))
- (refspec (oref repo pullreq-refspec))
- (name (magit-rev-name rev (cadr (split-string refspec ":")))))
- (save-match-data
- (and (string-match "\\([0-9]*\\)\\([~^][0-9]*\\)?\\'" name)
- (forge-get-pullreq (string-to-number (match-string 0 name)))))))
-
-;;; 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 t)
- (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)
- (or (and (fboundp 'forge-pullreq-p)
- (forge-pullreq-p topic))
- (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)
- (when (buffer-live-p prevbuf)
- (magit-refresh))))
-
-;;; _
-(provide 'forge-post)
-;;; forge-post.el ends here
+++ /dev/null
-;;; forge-pullreq.el --- Pullreq support -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2023 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-
-;; 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)
- (closed :initarg :closed)
- (merged :initarg :merged)
- (unread-p :initarg :unread-p :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)
- ))
-
-(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
-
-(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 t)))
- (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-ls-pullreqs ((repo forge-repository) &optional type select)
- (forge-ls-topics repo 'forge-pullreq type select))
-
-;;; Utilities
-
-(defun forge-read-pullreq (prompt &optional type)
- (when (eq type t)
- (setq type (if current-prefix-arg nil 'open)))
- (let* ((default (forge-current-pullreq))
- (repo (forge-get-repository (or default t)))
- (choices (mapcar
- (apply-partially #'forge--topic-format-choice repo)
- (forge-ls-pullreqs repo type [number title id class]))))
- (cdr (assoc (magit-completing-read
- prompt choices nil nil nil nil
- (and default
- (setq default (forge--topic-format-choice default))
- (member default choices)
- (car default)))
- choices))))
-
-(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)))
-
-(cl-defmethod forge-get-url ((pullreq forge-pullreq))
- (forge--format pullreq 'pullreq-url-format))
-
-(defun forge--pullreq-by-forge-short-link-at-point ()
- (forge--topic-by-forge-short-link-at-point '("#" "!") #'forge-get-pullreq))
-
-;;; Sections
-
-(defun forge-current-pullreq ()
- (or (forge-pullreq-at-point)
- (and (derived-mode-p 'forge-topic-mode)
- (forge-pullreq-p forge-buffer-topic)
- forge-buffer-topic)
- (and (derived-mode-p 'forge-topic-list-mode)
- (let ((topic (forge-get-topic (tabulated-list-get-id))))
- (and (forge-pullreq-p topic)
- topic)))))
-
-(defun forge-pullreq-at-point ()
- (or (magit-section-value-if 'pullreq)
- (and-let* ((post (magit-section-value-if 'post)))
- (cond ((forge-pullreq-p post)
- post)
- ((forge-pullreq-post-p post)
- (forge-get-pullreq post))))
- (forge--pullreq-by-forge-short-link-at-point)))
-
-(defvar-keymap forge-pullreqs-section-map
- "<remap> <magit-browse-thing>" #'forge-browse-pullreqs
- "<remap> <magit-visit-thing>" #'forge-list-pullreqs
- "C-c C-n" #'forge-create-pullreq)
-
-(defvar-keymap forge-pullreq-section-map
- "<remap> <magit-browse-thing>" #'forge-browse-pullreq
- "<remap> <magit-visit-thing>" #'forge-visit-pullreq)
-
-(defun forge-insert-pullreqs ()
- "Insert a list of mostly recent and/or open pull-requests.
-Also see option `forge-topic-list-limit'."
- (when (and forge-display-in-status-buffer (forge-db t))
- (when-let ((repo (forge-get-repository nil)))
- (unless (oref repo sparse-p)
- (forge-insert-topics "Pull requests"
- (forge-ls-recent-topics repo 'pullreq)
- (forge--topic-type-prefix repo 'pullreq))))))
-
-(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)))
- (magit-make-margin-overlay nil t))
- (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))))))
-
-(cl-defmethod forge--insert-topic-contents :after ((pullreq forge-pullreq)
- _width _prefix)
- (unless (oref pullreq merged)
- (magit-insert-heading)
- (forge--insert-pullreq-commits pullreq)))
-
-(cl-defmethod forge--format-topic-id ((pullreq forge-pullreq) &optional prefix)
- (propertize (format "%s%s"
- (or prefix (forge--topic-type-prefix pullreq))
- (oref pullreq number))
- 'font-lock-face (if (oref pullreq merged)
- 'forge-topic-merged
- 'forge-topic-unmerged)))
-
-(cl-defmethod forge--topic-type-prefix ((pullreq forge-pullreq))
- (if (forge--childp (forge-get-repository pullreq) 'forge-gitlab-repository)
- "!"
- "#"))
-
-(defun forge-insert-assigned-pullreqs ()
- "Insert a list of open pull-requests that are assigned to you."
- (when forge-display-in-status-buffer
- (when-let ((repo (forge-get-repository nil)))
- (unless (oref repo sparse-p)
- (forge-insert-topics "Assigned pull requests"
- (forge--ls-assigned-pullreqs repo)
- (forge--topic-type-prefix repo 'pullreq))))))
-
-(defun forge--ls-assigned-pullreqs (repo)
- (mapcar (lambda (row)
- (closql--remake-instance 'forge-pullreq (forge-db) row))
- (forge-sql
- [:select $i1 :from pullreq
- :join pullreq_assignee :on (= pullreq_assignee:pullreq pullreq:id)
- :join assignee :on (= pullreq_assignee:id assignee:id)
- :where (and (= pullreq:repository $s2)
- (= assignee:login $s3)
- (isnull pullreq:closed))
- :order-by [(desc updated)]]
- (vconcat (closql--table-columns (forge-db) 'pullreq t))
- (oref repo id)
- (ghub--username repo))))
-
-(defun forge-insert-requested-reviews ()
- "Insert a list of pull-requests that are awaiting your review."
- (when-let ((repo (forge-get-repository nil)))
- (unless (oref repo sparse-p)
- (forge-insert-topics "Pull requests awaiting review"
- (forge--ls-requested-reviews repo)
- (forge--topic-type-prefix repo 'pullreq)))))
-
-(defun forge--ls-requested-reviews (repo)
- (mapcar
- (lambda (row)
- (closql--remake-instance 'forge-pullreq (forge-db) row))
- (forge-sql
- [:select $i1 :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 $s2)
- (= assignee:login $s3)
- (isnull pullreq:closed))
- :order-by [(desc updated)]]
- (vconcat (closql--table-columns (forge-db) 'pullreq t))
- (oref repo id)
- (ghub--username repo))))
-
-(defun forge-insert-authored-pullreqs ()
- "Insert a list of open pullreqs that are authored to you."
- (when forge-display-in-status-buffer
- (when-let ((repo (forge-get-repository nil)))
- (unless (oref repo sparse-p)
- (forge-insert-topics "Authored pullreqs"
- (forge--ls-authored-pullreqs repo)
- (forge--topic-type-prefix repo 'pullreq))))))
-
-(defun forge--ls-authored-pullreqs (repo)
- (mapcar (lambda (row)
- (closql--remake-instance 'forge-pullreq (forge-db) row))
- (forge-sql
- [:select $i1 :from [pullreq]
- :where (and (= pullreq:repository $s2)
- (= pullreq:author $s3)
- (isnull pullreq:closed))
- :order-by [(desc updated)]]
- (vconcat (closql--table-columns (forge-db) 'pullreq t))
- (oref repo id)
- (ghub--username repo))))
-
-;;; _
-(provide 'forge-pullreq)
-;;; forge-pullreq.el ends here
+++ /dev/null
-;;; forge-repo.el --- Repository support -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2023 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-
-;; 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)
- (sparse-p :initform t)
- (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))
- :abstract t)
-
-(defclass forge-unusedapi-repository (forge-repository) () :abstract t)
-
-(defclass forge-noapi-repository (forge-repository) () :abstract t)
-
-;;; Core
-
-(cl-defmethod forge--repository-ids ((class (subclass forge-repository))
- host owner name &optional stub)
- "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)
- (or (assoc host forge-alist)
- (error "No entry for %S in forge-alist" host)))
- (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)))))
- (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)
- (let ((their-id (if owner (concat owner "/" name) name)))
- (cons (base64-encode-string
- (format "%s:%s"
- (nth 3 (or (assoc host forge-alist)
- (error "No entry for %S in forge-alist" host)))
- their-id)
- t)
- their-id)))
-
-(defvar-local forge-buffer-repository nil)
-(put 'forge-buffer-repository 'permanent-local t)
-
-(defconst forge--signal-no-entry '(t stub create))
-
-(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 (((_ id) (head :id)))
- (closql-get (forge-db) id 'forge-repository))
-
-(cl-defmethod forge-get-repository ((demand symbol) &optional remote)
- "Return the current forge repository.
-
-If the `forge-buffer-repository' is non-nil, then return that.
-Otherwise if `forge-buffer-topic' is non-nil, then return the
-repository for that. Finally if both variables are nil, then
-return the forge repository corresponding to the current Git
-repository, if any."
- (or forge-buffer-repository
- (and forge-buffer-topic
- (forge-get-repository forge-buffer-topic))
- (magit--with-refresh-cache
- (list default-directory 'forge-get-repository demand)
- (unless remote
- (setq remote (forge--get-remote 'warn)))
- (if-let ((url (and remote
- (magit-git-string "remote" "get-url" remote))))
- (when-let* ((repo (forge-get-repository url remote demand)))
- ;; Cannot use and-let* because of 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-url url)))
- (forge-get-repository parts remote demand)
- (when (memq demand forge--signal-no-entry)
- (error "Cannot determine forge repository. %s isn't a forge url" url))))
-
-(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."
- (if-let ((spec (assoc host forge-alist)))
- (pcase-let ((`(,githost ,apihost ,forge ,class) spec))
- (let* ((row (car (forge-sql [:select * :from repository
- :where (and (= forge $s1)
- (= owner $s2)
- (= name $s3))]
- forge owner name)))
- (obj (and row (closql--remake-instance class (forge-db) row))))
- (when obj
- (oset obj apihost apihost)
- (oset obj githost githost)
- (oset obj remote remote))
- (cond ((and (eq demand t)
- (or (not obj)
- (oref obj sparse-p)))
- (error "Cannot use `%s' in %S yet.\n%s"
- this-command (magit-toplevel)
- "Use `M-x forge-add-repository' before trying again."))
- ((and (eq demand 'full) obj
- (oref obj sparse-p))
- (setq obj nil)))
- (when (and (memq demand '(stub create))
- (not obj))
- (pcase-let ((`(,id . ,forge-id)
- (forge--repository-ids class host owner name
- (eq demand 'stub))))
- ;; The repo might have been renamed on the forge. #188
- (unless (setq obj (forge-get-repository (list :id id)))
- (setq obj (funcall class
- :id id
- :forge-id forge-id
- :forge forge
- :owner owner
- :name name
- :apihost apihost
- :githost githost
- :remote remote))
- (when (eq demand 'create)
- (closql-insert (forge-db) obj)))))
- 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))
- repo)
-
-;;; Utilities
-
-(defun forge-repository-at-point ()
- (magit-section-value-if 'forge-repo))
-
-(defun forge-current-repository ()
- (or (forge-repository-at-point)
- (and (derived-mode-p 'forge-repository-list-mode)
- (forge-get-repository (list :id (tabulated-list-get-id))))))
-
-(cl-defmethod forge-visit ((repo forge-repository))
- (let ((worktree (oref repo worktree)))
- (if (and worktree (file-directory-p worktree))
- (magit-status-setup-buffer worktree)
- (forge-list-issues (oref repo id)))))
-
-(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 (or (forge-current-repository)
- (forge-get-repository nil))))
- (format "%s/%s @%s"
- (oref default owner)
- (oref default name)
- (oref default githost))))))
- (save-match-data
- (if (string-match "\\`\\(.+\\)/\\([^/]+\\) @\\(.+\\)\\'" choice)
- (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
- (-keep (pcase-lambda (`(,githost ,_apihost ,_id ,c))
- (and (child-of-class-p c class) githost))
- forge-alist)
- (mapcar #'car forge-alist))
- nil t))
-
-(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 githost for %S" host)))
-
-(cl-defmethod forge--topics-until ((repo forge-repository) until table)
- (if (oref repo sparse-p)
- until
- (caar (forge-sql [:select [updated] :from $i1
- :where (= repository $s2)
- :order-by [(desc updated)]
- :limit 1]
- table (oref repo id)))))
-
-(cl-defmethod forge--format ((repo forge-repository) format-or-slot &optional spec)
- (format-spec
- (if (symbolp format-or-slot)
- (eieio-oref repo format-or-slot)
- format-or-slot)
- (with-slots (githost owner name) repo
- (let ((path (if owner (concat owner "/" name) name)))
- `(,@spec
- (?h . ,githost)
- (?o . ,owner)
- (?n . ,name)
- (?p . ,path)
- (?P . ,(string-replace "/" "%2F" path)))))))
-
-(cl-defmethod forge-get-url ((repo forge-repository))
- (forge--format (oref repo remote) 'remote-url-format))
-
-(defun forge--set-field-callback ()
- (let ((buf (current-buffer)))
- (lambda (&rest _)
- (with-current-buffer
- (or buf (current-buffer))
- (forge-pull)))))
-
-(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 ((sym (forge--ghub-type-symbol (eieio-object-class repo))))
- (cl-call-next-method (ghub--host sym) sym)))
-
-(defun forge--ghub-type-symbol (class)
- (cl-ecase class
- ;; This package does not define a `forge-gitlab-http-repository'
- ;; class, but we suggest at #9 that users define such a class if
- ;; they must connect to a Gitlab instance that uses http instead
- ;; of https.
- ((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-revnote.el --- Revnote support -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2023 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-
-;; 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-2023 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-
-;; 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)
-
-(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-topic.el --- Topics support -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2023 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-
-;; 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 issues")
- (cons (number :tag "Maximal number of open issues")
- (number :tag "Maximal number of closed issues"))))
-
-(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
-
-(defface forge-topic-unread
- '((t :inherit bold))
- "Face used for title of unread topics."
- :group 'forge-faces)
-
-(defface forge-topic-closed
- '((t :inherit magit-dimmed))
- "Face used for title of closed topics."
- :group 'forge-faces)
-
-(defface forge-topic-open
- '((t :inherit default))
- "Face used for title of open topics."
- :group 'forge-faces)
-
-(defface forge-topic-merged
- '((t :inherit magit-dimmed))
- "Face used for number of merged pull-requests."
- :group 'forge-faces)
-
-(defface forge-topic-unmerged
- '((t :inherit magit-dimmed :slant italic))
- "Face used for number of unmerged pull-requests."
- :group 'forge-faces)
-
-(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)
-
-(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 encode. 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))
-
-;;; Query
-
-(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)))
-
-(cl-defmethod forge-ls-recent-topics ((repo forge-repository) table)
- (magit--with-repository-local-cache (list 'forge-ls-recent-topics 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)
- (notnull unread-p))]
- 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)))))))
-
-(cl-defmethod forge-ls-topics ((repo forge-repository)
- class &optional type select)
- (let* ((table (oref-default class closql-table))
- (id (oref repo id))
- (rows (pcase-exhaustive type
- (`open (forge-sql [:select $i1 :from $i2
- :where (and (= repository $s3)
- (isnull closed))
- :order-by [(desc number)]]
- (or select '*) table id))
- (`closed (forge-sql [:select $i1 :from $i2
- :where (and (= repository $s3)
- (notnull closed))
- :order-by [(desc number)]]
- (or select '*) table id))
- (`nil (forge-sql [:select $i1 :from $i2
- :where (= repository $s3)
- :order-by [(desc number)]]
- (or select '*) table id)))))
- (if select
- rows
- (mapcar (lambda (row)
- (closql--remake-instance class (forge-db) row))
- rows))))
-
-;;; Utilities
-
-(cl-defmethod forge--format ((topic forge-topic) slot &optional spec)
- (forge--format (forge-get-repository topic) slot
- `(,@spec (?i . ,(oref topic number)))))
-
-(cl-defmethod forge-visit ((topic forge-topic))
- (forge-topic-setup-buffer topic)
- (forge-topic-mark-read (forge-get-repository topic) topic))
-
-(cl-defmethod forge-topic-mark-read ((_ forge-repository) topic)
- (oset topic unread-p nil))
-
-(defun forge--sanitize-string (string)
- ;; For Gitlab this may also be nil.
- (if string (string-replace "\r\n" "\n" string) ""))
-
-(defun forge-insert-topics (heading topics prefix)
- "Under a new section with HEADING, insert TOPICS."
- (when topics
- (let ((width (apply #'max
- (--map (length (number-to-string (oref it number)))
- topics)))
- list-section-type topic-section-type)
- (cond ((forge--childp (car topics) 'forge-issue)
- (setq list-section-type 'issues)
- (setq topic-section-type 'issue))
- ((forge--childp (car topics) 'forge-pullreq)
- (setq list-section-type 'pullreqs)
- (setq topic-section-type 'pullreq)))
- (magit-insert-section ((eval list-section-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-make-margin-overlay nil t)
- (magit-insert-section-body
- (dolist (topic topics)
- (forge-insert-topic topic topic-section-type width prefix))
- (insert ?\n)
- (magit-make-margin-overlay nil t))))))
-
-(defun forge-insert-topic (topic &optional topic-section-type width prefix)
- "Insert TOPIC as a new section.
-If TOPIC-SECTION-TYPE is provided, it is the section type to use.
-If WIDTH is provided, it is a fixed width to use for the topic
-identifier."
- (unless topic-section-type
- (setq topic-section-type
- (cond ((forge--childp topic 'forge-issue) 'issue)
- ((forge--childp topic 'forge-pullreq) 'pullreq))))
- (magit-insert-section ((eval topic-section-type) topic t)
- (forge--insert-topic-contents topic width prefix)))
-
-(cl-defmethod forge--format-topic-id ((topic forge-topic) &optional prefix)
- (propertize (format "%s%s"
- (or prefix (forge--topic-type-prefix topic))
- (oref topic number))
- 'font-lock-face 'magit-dimmed))
-
-(cl-defmethod forge--insert-topic-contents ((topic forge-topic) width prefix)
- (with-slots (number title unread-p closed) topic
- (insert (format (if width (format "%%-%is" (1+ width)) "%s")
- (forge--format-topic-id topic prefix)))
- (forge--insert-topic-marks topic)
- (insert " ")
- (insert (magit-log-propertize-keywords
- nil (propertize title 'font-lock-face
- (cond (unread-p 'forge-topic-unread)
- (closed 'forge-topic-closed)
- (t 'forge-topic-open)))))
- (forge--insert-topic-labels topic)
- (insert "\n")
- (magit-log-format-author-margin
- (oref topic author)
- (format-time-string "%s" (parse-iso8601-time-string (oref topic created)))
- t)))
-
-(defun forge--topic-by-forge-short-link-at-point (known-prefixes finder)
- "Finds a topic by forge-dependant short link around point.
-The topic number is expected to be a number prefixed by any of
-the elements in KNOWN-PREFIXES. If a reference is found, FINDER
-is called and a topic object is returned if available."
- (and-let* ((number (number-at-point))
- (prefix (buffer-substring-no-properties
- (- (match-beginning 0) 1)
- (match-beginning 0))))
- (and (member prefix known-prefixes)
- (funcall finder number))))
-
-;;; Mode
-
-(defvar-keymap forge-topic-mode-map
- "C-c C-n" #'forge-create-post
- "C-c C-r" #'forge-create-post
- "<remap> <magit-browse-thing>" #'forge-browse-topic
- "<remap> <magit-visit-thing>" #'markdown-follow-link-at-point
- "<mouse-2>" #'markdown-follow-link-at-point)
-
-(define-derived-mode forge-topic-mode magit-mode "View Topic"
- "View a forge issue or pull-request."
- (setq-local markdown-translate-filename-function
- #'forge--markdown-translate-filename-function))
-
-(defvar forge-topic-headers-hook
- '(forge-insert-topic-title
- forge-insert-topic-state
- forge-insert-topic-draft
- 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-keymap forge-post-section-map
- "<remap> <magit-browse-thing>" #'forge-browse-post
- "<remap> <magit-edit-thing>" #'forge-edit-post
- "C-c C-k" #'forge-delete-comment)
-
-(defvar-local forge-buffer-topic nil)
-(defvar-local forge-buffer-topic-ident nil)
-
-(defun forge-topic-setup-buffer (topic)
- (let* ((repo (forge-get-repository topic))
- (ident (concat (forge--topic-type-prefix topic)
- (number-to-string (oref topic number))))
- (name (format "*forge: %s/%s %s*"
- (oref repo owner)
- (oref repo name)
- ident))
- (magit-generate-buffer-name-function (lambda (_mode _value) name))
- (current-repo (forge-get-repository nil))
- (default-directory (if (and current-repo
- (eq (oref current-repo id)
- (oref repo id)))
- default-directory
- (or (oref repo worktree)
- default-directory))))
- (magit-setup-buffer #'forge-topic-mode t
- (forge-buffer-topic topic)
- (forge-buffer-topic-ident ident))))
-
-(defun forge-topic-refresh-buffer ()
- (let ((topic (closql-reload forge-buffer-topic)))
- (setq forge-buffer-topic topic)
- (magit-set-header-line-format
- (format "%s: %s" forge-buffer-topic-ident (oref topic title)))
- (magit-insert-section (topicbuf)
- (magit-insert-headers 'forge-topic-headers-hook)
- (when (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))
- forge-buffer-topic-ident)
-
-(defvar-keymap forge-topic-title-section-map
- "<remap> <magit-edit-thing>" #'forge-edit-topic-title)
-
-(cl-defun forge-insert-topic-title
- (&optional (topic forge-buffer-topic))
- (magit-insert-section (topic-title)
- (insert (format "%-11s" "Title: ") (oref topic title) "\n")))
-
-(defvar-keymap forge-topic-state-section-map
- "<remap> <magit-edit-thing>" #'forge-edit-topic-state)
-
-(cl-defun forge-insert-topic-state
- (&optional (topic forge-buffer-topic))
- (magit-insert-section (topic-state)
- (insert (format
- "%-11s%s\n" "State: "
- (let ((state (oref topic state)))
- (magit--propertize-face
- (symbol-name state)
- (pcase (list state (forge-pullreq-p (forge-topic-at-point)))
- ('(merged) 'forge-topic-merged)
- ('(closed) 'forge-topic-closed)
- ('(open t) 'forge-topic-unmerged)
- ('(open) 'forge-topic-open))))))))
-
-(defvar-keymap forge-topic-draft-section-map
- "<remap> <magit-edit-thing>" #'forge-edit-topic-draft)
-
-(cl-defun forge-insert-topic-draft
- (&optional (topic forge-buffer-topic))
- (when (forge-pullreq-p topic)
- (magit-insert-section (topic-draft)
- (insert (format "%-11s%s\n" "Draft: " (oref topic draft-p))))))
-
-(defvar-keymap forge-topic-milestone-section-map
- "<remap> <magit-edit-thing>" #'forge-edit-topic-milestone)
-
-(cl-defun forge-insert-topic-milestone
- (&optional (topic forge-buffer-topic))
- (magit-insert-section (topic-milestone)
- (insert (format "%-11s" "Milestone: ")
- (or (forge--get-topic-milestone topic)
- ;; If the user hasn't pulled this repository yet after
- ;; updating to db v7, then only the id is available.
- (oref topic milestone)
- (propertize "none" 'font-lock-face 'magit-dimmed))
- "\n")))
-
-(defun forge--get-topic-milestone (topic)
- (and-let* ((id (oref topic milestone)))
- (caar (forge-sql [:select [title] :from milestone :where (= id $s1)] id))))
-
-(defvar-keymap forge-topic-labels-section-map
- "<remap> <magit-edit-thing>" #'forge-edit-topic-labels)
-
-(cl-defun forge-insert-topic-labels
- (&optional (topic forge-buffer-topic))
- (magit-insert-section (topic-labels)
- (insert (format "%-11s" "Labels: "))
- (if-let ((labels (closql--iref topic 'labels)))
- (forge--insert-topic-labels topic t labels)
- (insert (propertize "none" 'font-lock-face 'magit-dimmed)))
- (insert ?\n)))
-
-(defun forge--format-topic-labels (topic)
- (and-let* ((labels (closql--iref topic 'labels)))
- (mapconcat (pcase-lambda (`(,name ,color ,_desc))
- (propertize name 'font-lock-face (list :box color)))
- labels " ")))
-
-(defun forge--insert-topic-labels (topic &optional skip-separator labels)
- (pcase-dolist (`(,name ,color ,description)
- (or labels (closql--iref topic 'labels)))
- (if skip-separator
- (setq skip-separator nil)
- (insert " "))
- (let* ((background (forge--sanitize-color color))
- (foreground (forge--contrast-color background)))
- (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))))))
-
-(defvar-keymap forge-topic-marks-section-map
- "<remap> <magit-edit-thing>" #'forge-edit-topic-marks)
-
-(cl-defun forge-insert-topic-marks
- (&optional (topic forge-buffer-topic))
- (magit-insert-section (topic-marks)
- (insert (format "%-11s" "Marks: "))
- (if-let ((marks (closql--iref topic 'marks)))
- (forge--insert-topic-marks topic t marks)
- (insert (propertize "none" 'font-lock-face 'magit-dimmed)))
- (insert ?\n)))
-
-(defun forge--insert-topic-marks (topic &optional skip-separator marks)
- (pcase-dolist (`(,name ,face ,description)
- (or marks (closql--iref topic 'marks)))
- (if skip-separator
- (setq skip-separator nil)
- (insert " "))
- (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--sanitize-color (color)
- (cond ((x-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 (x-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))
-
-(cl-defun forge-insert-topic-refs
- (&optional (topic forge-buffer-topic))
- (when (forge-pullreq-p topic)
- (magit-insert-section (topic-refs)
- (with-slots (cross-repo-p base-repo base-ref head-repo head-ref) topic
- (let ((separator (propertize ":" 'font-lock-face 'magit-dimmed))
- (deleted (propertize "(deleted)" 'font-lock-face 'magit-dimmed)))
- (insert (format "%-11s" "Refs: ")
- (if cross-repo-p
- (concat base-repo separator base-ref)
- base-ref)
- (propertize "..." 'font-lock-face 'magit-dimmed)
- (if cross-repo-p
- (if (and head-repo head-ref)
- (concat head-repo separator head-ref)
- deleted)
- (or head-ref deleted))
- "\n"))))))
-
-(defvar-keymap forge-topic-assignees-section-map
- "<remap> <magit-edit-thing>" #'forge-edit-topic-assignees)
-
-(cl-defun forge-insert-topic-assignees
- (&optional (topic forge-buffer-topic))
- (magit-insert-section (topic-assignees)
- (insert (format "%-11s" "Assignees: "))
- (if-let ((assignees (closql--iref topic 'assignees)))
- (insert (mapconcat (pcase-lambda (`(,login ,name))
- (format "%s%s (@%s)"
- (forge--format-avatar login)
- name login))
- assignees ", "))
- (insert (propertize "none" 'font-lock-face 'magit-dimmed)))
- (insert ?\n)))
-
-(defvar-keymap forge-topic-review-requests-section-map
- "<remap> <magit-edit-thing>" #'forge-edit-topic-review-requests)
-
-(cl-defun forge-insert-topic-review-requests
- (&optional (topic forge-buffer-topic))
- (when (forge-pullreq-p topic)
- (magit-insert-section (topic-review-requests)
- (insert (format "%-11s" "Review-Requests: "))
- (if-let ((review-requests (closql--iref topic 'review-requests)))
- (insert (mapconcat (pcase-lambda (`(,login ,name))
- (format "%s%s (@%s)"
- (forge--format-avatar login)
- name login))
- review-requests ", "))
- (insert (propertize "none" 'font-lock-face 'magit-dimmed)))
- (insert ?\n))))
-
-(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)))
-
-(cl-defmethod forge--topic-type-prefix ((_ forge-topic))
- "Get the identifier prefix specific to the type of TOPIC."
- "#")
-
-(cl-defmethod forge--topic-type-prefix ((_repo forge-repository) _type)
- "#")
-
-(defun forge--markdown-translate-filename-function (file)
- (if (string-match-p "\\`https?://" file)
- file
- (let ((host (oref (forge-get-repository t) githost)))
- (concat (if (member host ghub-insecure-hosts) "http://" "https://")
- host
- (and (not (string-prefix-p "/" file)) "/")
- file))))
-
-(defun forge--format-avatar (author)
- (if forge-format-avatar-function
- (funcall forge-format-avatar-function author)
- ""))
-
-;;; Completion
-
-(defun forge-read-topic (prompt &optional type allow-number)
- (when (eq type t)
- (setq type (if current-prefix-arg nil 'open)))
- (let* ((default (forge-current-topic))
- (repo (forge-get-repository (or default t)))
- (choices (mapcar
- (apply-partially #'forge--topic-format-choice repo)
- (cl-sort
- (nconc
- (forge-ls-pullreqs repo type [number title id class])
- (forge-ls-issues repo type [number title id class]))
- #'> :key #'car)))
- (choice (magit-completing-read
- prompt choices nil nil nil nil
- (and default
- (setq default (forge--topic-format-choice default))
- (member default choices)
- (car default)))))
- (or (cdr (assoc choice choices))
- (and allow-number
- (let ((number (string-to-number choice)))
- (if (= number 0)
- (user-error "Not an existing topic or number: %s")
- number))))))
-
-(cl-defmethod forge--topic-format-choice ((topic forge-topic))
- (cons (format "%s%s %s"
- (forge--topic-type-prefix topic)
- (oref topic number)
- (oref topic title))
- (oref topic id)))
-
-(cl-defmethod forge--topic-format-choice ((repo forge-repository) args)
- (pcase-let ((`(,number ,title ,id ,class) args))
- (cons (format "%s%s %s"
- (forge--topic-type-prefix repo class)
- number
- title)
- id)))
-
-(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 t))
- (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))))))
-
-;;; Parse
-
-(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)))
-
-;;; Templates
-
-(cl-defgeneric forge--topic-templates (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-templates 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)))
- (magit--with-safe-default-directory nil
- (when-let ((repo (forge-get-repository 'full)))
- (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.el --- Access Git forges from Magit -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2023 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
-;; 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-list)
-
-;;; 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.")
-
-(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.
-
-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.")
-
-;;;###autoload
-(with-eval-after-load 'git-commit
- (when forge-add-default-bindings
- (define-key git-commit-mode-map (kbd "C-c C-v") #'forge-visit-topic)))
-
-;;;###autoload
-(with-eval-after-load 'magit-mode
- (when forge-add-default-bindings
- (define-key magit-mode-map "'" #'forge-dispatch)
- (define-key magit-mode-map "N" #'forge-dispatch)))
-
-(when forge-add-default-bindings
- (define-key magit-commit-section-map [remap magit-browse-thing] #'forge-browse-dwim)
- (define-key magit-remote-section-map [remap magit-browse-thing] #'forge-browse-remote)
- (define-key magit-branch-section-map [remap magit-browse-thing] #'forge-browse-branch)
-
- (define-key magit-commit-section-map (kbd "C-c C-v") #'forge-visit-topic)
- (define-key magit-branch-section-map (kbd "C-c C-v") #'forge-visit-topic)
-
- (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)
- (not (equal (getenv "TRAVIS") "true")))
- (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-2023 Jonas Bernoulli <jonasNOSPAMbernoul.li>
-
- 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-2023 Jonas Bernoulli <jonasNOSPAMbernoul.li>
-
- 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’.
-
- 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’.
-
-\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 N’ (‘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 n’ (‘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 Options: 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 two 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 three 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 N: Branching. (line 13)
-* b n: 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 73)
-* N l n: Listing Topics and Notifications.
- (line 65)
-* N l p: Listing Topics and Notifications.
- (line 69)
-* N l r: Listing Topics and Notifications.
- (line 62)
-* 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 50)
-* forge-insert-assigned-pullreqs: Listing Topics and Notifications.
- (line 38)
-* forge-insert-authored-issues: Listing Topics and Notifications.
- (line 54)
-* forge-insert-authored-pullreqs: Listing Topics and Notifications.
- (line 46)
-* forge-insert-issues: Listing Topics and Notifications.
- (line 17)
-* forge-insert-pullreqs: Listing Topics and Notifications.
- (line 13)
-* forge-insert-requested-reviews: Listing Topics and Notifications.
- (line 42)
-* forge-list-assigned-issues: Listing Topics and Notifications.
- (line 88)
-* forge-list-assigned-pullreqs: Listing Topics and Notifications.
- (line 84)
-* forge-list-authored-issues: Listing Topics and Notifications.
- (line 100)
-* forge-list-authored-pullreqs: Listing Topics and Notifications.
- (line 96)
-* forge-list-issues: Listing Topics and Notifications.
- (line 73)
-* forge-list-labeled-issues: Listing Topics and Notifications.
- (line 80)
-* forge-list-labeled-pullreqs: Listing Topics and Notifications.
- (line 76)
-* forge-list-notifications: Listing Topics and Notifications.
- (line 65)
-* forge-list-owned-issues: Listing Topics and Notifications.
- (line 110)
-* forge-list-owned-pullreqs: Listing Topics and Notifications.
- (line 104)
-* forge-list-pullreqs: Listing Topics and Notifications.
- (line 69)
-* forge-list-repositories: Listing Topics and Notifications.
- (line 62)
-* forge-list-requested-reviews: Listing Topics and Notifications.
- (line 92)
-* 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 31)
-* 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-owned-accounts: Listing Topics and Notifications.
- (line 116)
-* forge-owned-ignored: Listing Topics and Notifications.
- (line 131)
-* forge-topic-list-limit: Listing Topics and Notifications.
- (line 20)
-* forge.remote: Repository Detection.
- (line 66)
-
-
-\1f
-Tag Table:
-Node: Top\7f751
-Node: Introduction\7f2435
-Node: Supported Forges and Hosts\7f2998
-Node: Supported Forges\7f4248
-Ref: Github\7f4404
-Ref: Github Caveats\7f4547
-Ref: Github Hosts\7f5193
-Ref: Gitlab\7f5249
-Ref: Gitlab Caveats\7f5264
-Ref: Gitlab Hosts\7f5389
-Node: Partially Supported Forges\7f5509
-Ref: Gitea https//giteaio\7f5715
-Ref: Gitea Hosts\7f5815
-Ref: Gogs https//gogsio\7f5871
-Ref: Gogs Hosts\7f6074
-Ref: Bitbucket https//bitbucketorg\7f6132
-Ref: Bitbucket Caveats\7f6330
-Ref: Bitbucket Hosts\7f7227
-Node: Supported Semi-Forges\7f7292
-Ref: Gitweb https//git-scmcom/docs/gitweb\7f7463
-Ref: Gitweb Caveats\7f7542
-Ref: Cgit https//gitzx2c4com/cgit/about\7f7782
-Ref: Cgit Caveats\7f7859
-Ref: Cgit Hosts\7f8208
-Ref: Stgit https//codemadnessorg/git/stagit/file/READMEhtml\7f8335
-Ref: Stgit Caveats\7f8452
-Ref: Stgit Hosts\7f8738
-Ref: Srht https//metasrht\7f8798
-Ref: Srht Caveats\7f8847
-Ref: Srht Hosts\7f9130
-Node: Getting Started\7f9181
-Node: Loading Forge\7f10179
-Node: Token Creation\7f10574
-Node: Initial Pull\7f11853
-Node: Repository Detection\7f13248
-Node: Caveats\7f17387
-Node: Usage\7f18313
-Node: Pulling\7f19785
-Node: Branching\7f22468
-Node: Working with Topics\7f28857
-Node: Visiting Topics\7f29230
-Node: Listing Topics and Notifications\7f31307
-Node: Creating Topics\7f36631
-Node: Editing Topics and Posts\7f37120
-Node: Miscellaneous\7f41647
-Node: FAQ\7f44270
-Node: Is it possible to create a single pull-request without pulling everything?\7f44738
-Node: error in process filter HTTP Error 502 "Bad gateway"\7f45204
-Node: Keystroke Index\7f47575
-Node: Function and Command Index\7f53265
-Node: Variable Index\7f61223
-\1f
-End Tag Table
-
-\1f
-Local Variables:
-coding: utf-8
-End:
--- /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 -*- lexical-binding: t -*-
+;;
+;;; Code:
+
+(add-to-list 'load-path (directory-file-name
+ (or (file-name-directory #$) (car load-path))))
+
+\f
+;;;### (autoloads nil "forge" "forge.el" (0 0 0 0))
+;;; 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.
+
+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.")
+
+(with-eval-after-load 'git-commit (when forge-add-default-bindings (define-key git-commit-mode-map (kbd "C-c C-v") #'forge-visit-topic)))
+
+(with-eval-after-load 'magit-mode (when forge-add-default-bindings (define-key magit-mode-map "'" #'forge-dispatch) (define-key magit-mode-map "N" #'forge-dispatch)))
+
+(register-definition-prefixes "forge" '("forge-"))
+
+;;;***
+\f
+;;;### (autoloads nil "forge-bitbucket" "forge-bitbucket.el" (0 0
+;;;;;; 0 0))
+;;; Generated autoloads from forge-bitbucket.el
+
+(register-definition-prefixes "forge-bitbucket" '("forge-bitbucket-repository"))
+
+;;;***
+\f
+;;;### (autoloads nil "forge-commands" "forge-commands.el" (0 0 0
+;;;;;; 0))
+;;; Generated autoloads from forge-commands.el
+ (autoload 'forge-dispatch "forge-commands" nil t)
+
+(autoload 'forge-pull "forge-commands" "\
+Pull topics from the forge repository.
+
+With a prefix argument and if the repository has not been fetched
+before, then read a date from the user and limit pulled topics to
+those that have been updated since then.
+
+If pulling is too slow, then also consider setting the Git variable
+`forge.omitExpensive' to `true'.
+
+\(fn &optional REPO UNTIL)" t nil)
+
+(autoload 'forge-pull-notifications "forge-commands" "\
+Fetch notifications for all repositories from the current forge." t nil)
+
+(autoload 'forge-pull-topic "forge-commands" "\
+Pull the API data for the current topic.
+If there is no current topic or with a prefix argument read a
+TOPIC to pull instead.
+
+\(fn TOPIC)" t nil)
+
+(autoload 'forge-browse-dwim "forge-commands" "\
+Visit a topic, branch or commit using a browser.
+Prefer a topic over a branch and that over a commit." t nil)
+
+(autoload 'forge-browse-commit "forge-commands" "\
+Visit the url corresponding to REV using a browser.
+
+\(fn REV)" t nil)
+
+(autoload 'forge-copy-url-at-point-as-kill "forge-commands" "\
+Copy the url of the thing at point." t nil)
+
+(autoload 'forge-browse-branch "forge-commands" "\
+Visit the url corresponding BRANCH using a browser.
+
+\(fn BRANCH)" t nil)
+
+(autoload 'forge-browse-remote "forge-commands" "\
+Visit the url corresponding to REMOTE using a browser.
+
+\(fn REMOTE)" t nil)
+
+(autoload 'forge-browse-repository "forge-commands" "\
+View the current repository in a separate buffer.
+
+\(fn REPO)" t nil)
+
+(autoload 'forge-browse-topic "forge-commands" "\
+Visit the current topic using a browser." t nil)
+
+(autoload 'forge-browse-pullreqs "forge-commands" "\
+Visit the pull-requests of the current repository using a browser." t nil)
+
+(autoload 'forge-browse-pullreq "forge-commands" "\
+Visit the url corresponding to PULLREQ using a browser.
+
+\(fn PULLREQ)" t nil)
+
+(autoload 'forge-browse-issues "forge-commands" "\
+Visit the issues of the current repository using a browser." t nil)
+
+(autoload 'forge-browse-issue "forge-commands" "\
+Visit the current issue using a browser.
+If there is no current issue or with a prefix argument
+read an ISSUE to visit.
+
+\(fn ISSUE)" t nil)
+
+(autoload 'forge-browse-post "forge-commands" "\
+Visit the current post using a browser." t nil)
+
+(autoload 'forge-visit-topic "forge-commands" "\
+View the current topic in a separate buffer.
+If there is no current topic or with a prefix argument
+read a topic to visit instead.
+
+\(fn TOPIC)" t nil)
+
+(autoload 'forge-visit-pullreq "forge-commands" "\
+View the current pull-request in a separate buffer.
+If there is no current pull-request or with a prefix argument
+read a PULLREQ to visit instead. If point is looking at a pullreq
+reference with Gitlab/Github notation try to visit the pullreq
+with that number.
+
+\(fn PULLREQ)" t nil)
+
+(autoload 'forge-visit-issue "forge-commands" "\
+Visit the current issue in a separate buffer.
+If there is no current issue or with a prefix argument read an
+ISSUE to visit instead. If point is looking at an issue reference
+with Gitlab/Github notation try to visit the issue with that
+number.
+
+\(fn ISSUE)" t nil)
+
+(autoload 'forge-visit-repository "forge-commands" "\
+View the current repository in a separate buffer.
+
+\(fn REPO)" t nil)
+
+(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 nil)
+
+(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 nil)
+
+(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 nil)
+
+(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 nil)
+
+(autoload 'forge-list-notifications "forge-commands" "\
+List notifications." t nil)
+
+(autoload 'forge-add-pullreq-refspec "forge-commands" "\
+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." t nil)
+
+(autoload 'forge-add-repository "forge-commands" "\
+Add a repository to the database.
+Offer to either pull topics (now and in the future) or to only
+pull individual topics when the user invokes `forge-pull-topic'.
+
+\(fn URL)" t nil)
+
+(function-put 'forge-add-repository 'interactive-only '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 nil)
+
+(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 nil)
+
+(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 nil)
+
+(autoload 'forge-remove-repository "forge-commands" "\
+Remove a repository from the database.
+
+\(fn HOST OWNER NAME)" t nil)
+
+(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 nil)
+
+(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 nil)
+
+(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 nil)
+
+(register-definition-prefixes "forge-commands" '("forge-"))
+
+;;;***
+\f
+;;;### (autoloads nil "forge-core" "forge-core.el" (0 0 0 0))
+;;; Generated autoloads from forge-core.el
+
+(register-definition-prefixes "forge-core" '("forge-"))
+
+;;;***
+\f
+;;;### (autoloads nil "forge-db" "forge-db.el" (0 0 0 0))
+;;; Generated autoloads from forge-db.el
+
+(register-definition-prefixes "forge-db" '("forge-"))
+
+;;;***
+\f
+;;;### (autoloads nil "forge-gitea" "forge-gitea.el" (0 0 0 0))
+;;; Generated autoloads from forge-gitea.el
+
+(register-definition-prefixes "forge-gitea" '("forge-gitea-repository"))
+
+;;;***
+\f
+;;;### (autoloads nil "forge-github" "forge-github.el" (0 0 0 0))
+;;; Generated autoloads from forge-github.el
+
+(register-definition-prefixes "forge-github" '("forge-"))
+
+;;;***
+\f
+;;;### (autoloads nil "forge-gitlab" "forge-gitlab.el" (0 0 0 0))
+;;; Generated autoloads from forge-gitlab.el
+
+(register-definition-prefixes "forge-gitlab" '("forge-gitlab-repository"))
+
+;;;***
+\f
+;;;### (autoloads nil "forge-gogs" "forge-gogs.el" (0 0 0 0))
+;;; Generated autoloads from forge-gogs.el
+
+(register-definition-prefixes "forge-gogs" '("forge-gogs-repository"))
+
+;;;***
+\f
+;;;### (autoloads nil "forge-issue" "forge-issue.el" (0 0 0 0))
+;;; Generated autoloads from forge-issue.el
+
+(register-definition-prefixes "forge-issue" '("forge-"))
+
+;;;***
+\f
+;;;### (autoloads nil "forge-list" "forge-list.el" (0 0 0 0))
+;;; Generated autoloads from forge-list.el
+
+(autoload 'forge-list-topics "forge-list" "\
+List topics of the current repository in a separate buffer.
+
+\(fn ID)" t nil)
+
+(autoload 'forge-list-issues "forge-list" "\
+List issues of the current repository in a separate buffer.
+
+\(fn ID)" t nil)
+
+(autoload 'forge-list-labeled-issues "forge-list" "\
+List issues of the current repository that have LABEL.
+List them in a separate buffer.
+
+\(fn ID LABEL)" t nil)
+
+(autoload 'forge-list-assigned-issues "forge-list" "\
+List issues of the current repository that are assigned to you.
+List them in a separate buffer.
+
+\(fn ID)" t nil)
+
+(autoload 'forge-list-owned-issues "forge-list" "\
+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." t nil)
+
+(autoload 'forge-list-pullreqs "forge-list" "\
+List pull-requests of the current repository in a separate buffer.
+
+\(fn ID)" t nil)
+
+(autoload 'forge-list-labeled-pullreqs "forge-list" "\
+List pull-requests of the current repository that have LABEL.
+List them in a separate buffer.
+
+\(fn ID LABEL)" t nil)
+
+(autoload 'forge-list-assigned-pullreqs "forge-list" "\
+List pull-requests of the current repository that are assigned to you.
+List them in a separate buffer.
+
+\(fn ID)" t nil)
+
+(autoload 'forge-list-requested-reviews "forge-list" "\
+List pull-requests of the current repository that are awaiting your review.
+List them in a separate buffer.
+
+\(fn ID)" t nil)
+
+(autoload 'forge-list-owned-pullreqs "forge-list" "\
+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." t nil)
+
+(autoload 'forge-list-authored-pullreqs "forge-list" "\
+List open pull-requests of the current repository that are authored by you.
+List them in a separate buffer.
+
+\(fn ID)" t nil)
+
+(autoload 'forge-list-authored-issues "forge-list" "\
+List open issues from the current repository that are authored by you.
+List them in a separate buffer.
+
+\(fn ID)" t nil)
+
+(autoload 'forge-list-repositories "forge-list" "\
+List known repositories in a separate buffer.
+Here \"known\" means that an entry exists in the local database." t nil)
+
+(autoload 'forge-list-owned-repositories "forge-list" "\
+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." t nil)
+
+(register-definition-prefixes "forge-list" '("forge-"))
+
+;;;***
+\f
+;;;### (autoloads nil "forge-notify" "forge-notify.el" (0 0 0 0))
+;;; Generated autoloads from forge-notify.el
+
+(register-definition-prefixes "forge-notify" '("forge-"))
+
+;;;***
+\f
+;;;### (autoloads nil "forge-post" "forge-post.el" (0 0 0 0))
+;;; Generated autoloads from forge-post.el
+
+(register-definition-prefixes "forge-post" '("forge-"))
+
+;;;***
+\f
+;;;### (autoloads nil "forge-pullreq" "forge-pullreq.el" (0 0 0 0))
+;;; Generated autoloads from forge-pullreq.el
+
+(register-definition-prefixes "forge-pullreq" '("forge-"))
+
+;;;***
+\f
+;;;### (autoloads nil "forge-repo" "forge-repo.el" (0 0 0 0))
+;;; Generated autoloads from forge-repo.el
+
+(register-definition-prefixes "forge-repo" '("forge-"))
+
+;;;***
+\f
+;;;### (autoloads nil "forge-revnote" "forge-revnote.el" (0 0 0 0))
+;;; Generated autoloads from forge-revnote.el
+
+(register-definition-prefixes "forge-revnote" '("forge-revnote"))
+
+;;;***
+\f
+;;;### (autoloads nil "forge-semi" "forge-semi.el" (0 0 0 0))
+;;; Generated autoloads from forge-semi.el
+
+(register-definition-prefixes "forge-semi" '("forge-"))
+
+;;;***
+\f
+;;;### (autoloads nil "forge-topic" "forge-topic.el" (0 0 0 0))
+;;; Generated autoloads from forge-topic.el
+
+(register-definition-prefixes "forge-topic" '("forge-"))
+
+;;;***
+\f
+;;;### (autoloads nil nil ("forge-pkg.el") (0 0 0 0))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; forge-autoloads.el ends here
--- /dev/null
+;;; forge-bitbucket.el --- Bitbucket support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+;; 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-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+;; 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."
+ [["Fetch"
+ ("f f" "all topics" forge-pull)
+ ("f t" "one topic" forge-pull-topic)
+ ("f n" "notifications" forge-pull-notifications)
+ """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 (lambda () (forge-github-repository-p (forge-get-repository nil))))
+ ("c f" "fork or remote" forge-fork)
+ """Merge"
+ (7 "M " "merge using API" forge-merge)]
+ ["List"
+ ("l t" "topics" forge-list-topics)
+ ("l i" "issues" forge-list-issues)
+ ("l p" "pull-requests" forge-list-pullreqs)
+ ("l n" "notifications" forge-list-notifications)
+ ("l r" "repositories" forge-list-repositories)
+ (7 "l a" "awaiting review" forge-list-requested-reviews)
+ (7 "n i" "labeled issues" forge-list-labeled-issues)
+ (7 "n p" "labeled pull-requests" forge-list-labeled-pullreqs)
+ (7 "m i" "authored issues" forge-list-authored-issues)
+ (7 "m p" "authored pull-requests" forge-list-authored-pullreqs)
+ (7 "o i" "owned issues" forge-list-owned-issues)
+ (7 "o p" "owned pull-requests" forge-list-owned-pullreqs)
+ (7 "o r" "owned repositories" forge-list-owned-repositories)]
+ ["Visit"
+ ("v t" "topic" forge-visit-topic)
+ ("v i" "issue" forge-visit-issue)
+ ("v p" "pull-request" forge-visit-pullreq)
+ """Browse"
+ ("b I" "issues" forge-browse-issues)
+ ("b P" "pull-requests" forge-browse-pullreqs)
+ ("b t" "topic" forge-browse-topic)
+ ("b i" "issue" forge-browse-issue)
+ ("b p" "pull-request" forge-browse-pullreq)
+ ("b r" "remote" forge-browse-remote)]]
+ [["Configure"
+ ("a " "add repository to database" forge-add-repository)
+ ("R " "add pull-request refspec" forge-add-pullreq-refspec
+ :if-not forge--pullreq-refspec)
+ ("r " "forge.remote" forge-forge.remote)
+ ("t l" "forge.graphqlItemLimit" forge-forge.graphqlItemLimit
+ :if (lambda () (forge-github-repository-p (forge-get-repository nil))))
+ ("t t" forge-toggle-display-in-status-buffer)
+ ("t c" forge-toggle-closed-visibility)]])
+
+;;; Pull
+
+;;;###autoload
+(defun forge-pull (&optional repo until interactive)
+ "Pull topics from the forge repository.
+
+With a prefix argument and if the repository has not been fetched
+before, then read a date from the user and limit pulled topics to
+those that have been updated since then.
+
+If pulling is too slow, then also consider setting the Git variable
+`forge.omitExpensive' to `true'.
+\n(fn &optional REPO UNTIL)"
+ (interactive
+ (list nil
+ (and current-prefix-arg
+ (not (forge-get-repository 'full))
+ (forge-read-date "Limit pulling to topics updates since: "))
+ t))
+ (let (create)
+ (unless repo
+ (setq repo (forge-get-repository 'full))
+ (unless repo
+ (setq repo (forge-get-repository 'create))
+ (setq create t)))
+ (when (or create interactive (magit-git-config-p "forge.autoPull" t))
+ (forge--zap-repository-cache repo)
+ (when (and interactive
+ (oref repo selective-p)
+ (yes-or-no-p
+ (format "Always pull all of %s/%s's topics going forward?"
+ (oref repo owner)
+ (oref repo name))))
+ (oset repo selective-p nil))
+ (setq forge--mode-line-buffer (current-buffer))
+ (when-let* ((remote (oref repo remote))
+ (refspec (oref repo pullreq-refspec)))
+ (when (and create
+ (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)))
+ (forge--msg repo t nil "Pulling REPO")
+ (forge--pull repo until))))
+
+(defun forge-read-date (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) _until) ; NOOP
+ (forge--msg repo t t "Pulling from REPO is not supported"))
+
+(cl-defmethod forge--pull ((repo forge-unusedapi-repository) _until)
+ (oset repo sparse-p nil)
+ (magit-git-fetch (oref repo remote) (magit-fetch-arguments)))
+
+(defun forge--git-fetch (buf dir repo)
+ (if (buffer-live-p buf)
+ (with-current-buffer buf
+ (magit-git-fetch (oref repo remote) (magit-fetch-arguments)))
+ (let ((default-directory dir))
+ (magit-git-fetch (oref repo remote) (magit-fetch-arguments)))))
+
+;;;###autoload
+(defun forge-pull-notifications ()
+ "Fetch notifications for all repositories from the current forge."
+ (interactive)
+ (let* ((repo (forge-get-repository 'stub))
+ (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)))))
+
+;;;###autoload
+(defun forge-pull-topic (topic)
+ "Pull the API data for the current topic.
+If there is no current topic or with a prefix argument read a
+TOPIC to pull instead."
+ (interactive (list (forge-read-topic "Pull topic" nil t)))
+ (let ((repo (forge-get-repository t)))
+ (forge--zap-repository-cache repo)
+ (forge--pull-topic repo
+ (if (numberp topic)
+ (forge-issue :repository (oref repo id)
+ :number topic)
+ (forge-get-topic topic)))))
+
+(cl-defmethod forge--pull-topic ((repo forge-repository) _topic)
+ (error "Fetching an individual topic not implemented for %s"
+ (eieio-object-class repo)))
+
+(defun forge--zap-repository-cache (&optional repo)
+ (when-let ((r (if repo
+ (oref repo worktree)
+ (magit-repository-local-repository))))
+ (magit-repository-local-delete (list 'forge-ls-recent-topics 'issue) r)
+ (magit-repository-local-delete (list 'forge-ls-recent-topics 'pullreq) r)))
+
+;;; Browse
+
+;;;###autoload
+(defun forge-browse-dwim ()
+ "Visit a topic, branch or commit using a browser.
+Prefer a topic over a branch and that over a commit."
+ (interactive)
+ (if-let ((topic (forge-topic-at-point)))
+ (forge-browse topic)
+ (if-let ((branch (magit-branch-at-point)))
+ (forge-browse-branch branch)
+ (call-interactively #'forge-browse-commit))))
+
+;;;###autoload
+(defun forge-browse-commit (rev)
+ "Visit the url corresponding to REV 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"))))
+ (let ((repo (forge-get-repository 'stub)))
+ (unless (magit-list-containing-branches
+ rev "-r" (concat (oref repo remote) "/*"))
+ (if-let ((branch (car (magit-list-containing-branches rev "-r"))))
+ (setq repo (forge-get-repository
+ 'stub (cdr (magit-split-branch-name branch))))
+ (message "%s does not appear to be available on any remote. %s"
+ rev "You might have to push it first.")))
+ (browse-url
+ (forge--format repo 'commit-url-format
+ `((?r . ,(magit-commit-p rev)))))))
+
+;;;###autoload
+(defun forge-copy-url-at-point-as-kill ()
+ "Copy the url of the thing at point."
+ (interactive)
+ (if-let ((url (forge-get-url (or (forge-post-at-point)
+ (forge-current-topic)))))
+ (progn
+ (kill-new url)
+ (message "Copied %S" url))
+ (user-error "Nothing at point with a URL")))
+
+;;;###autoload
+(defun forge-browse-branch (branch)
+ "Visit the url corresponding BRANCH using a browser."
+ (interactive (list (magit-read-branch "Browse branch")))
+ (let (remote)
+ (if (magit-remote-branch-p branch)
+ (let ((cons (magit-split-branch-name branch)))
+ (setq remote (car cons))
+ (setq branch (cdr cons)))
+ (or (setq remote (or (magit-get-push-remote branch)
+ (magit-get-upstream-remote branch)))
+ (user-error "Cannot determine remote for %s" branch)))
+ (browse-url (forge--format remote 'branch-url-format
+ `((?r . ,branch))))))
+
+;;;###autoload
+(defun forge-browse-remote (remote)
+ "Visit the url corresponding to REMOTE using a browser."
+ (interactive (list (magit-read-remote "Browse remote")))
+ (browse-url (forge--format remote 'remote-url-format)))
+
+;;;###autoload
+(defun forge-browse-repository (repo)
+ "View the current repository in a separate buffer."
+ (interactive
+ (list (or (forge-current-repository)
+ (forge-get-repository
+ (forge-read-repository "Browse repository")))))
+ (browse-url (forge--format repo 'remote-url-format)))
+
+;;;###autoload
+(defun forge-browse-topic ()
+ "Visit the current topic using a browser."
+ (interactive)
+ (if-let ((topic (forge-current-topic)))
+ (forge-browse topic)
+ (user-error "There is no current topic")))
+
+;;;###autoload
+(defun forge-browse-pullreqs ()
+ "Visit the pull-requests of the current repository using a browser."
+ (interactive)
+ (browse-url (forge--format (forge-get-repository 'stub)
+ 'pullreqs-url-format)))
+
+;;;###autoload
+(defun forge-browse-pullreq (pullreq)
+ "Visit the url corresponding to PULLREQ using a browser."
+ (interactive (list (forge-read-pullreq "Browse pull-request" t)))
+ (forge-browse (forge-get-pullreq pullreq)))
+
+;;;###autoload
+(defun forge-browse-issues ()
+ "Visit the issues of the current repository using a browser."
+ (interactive)
+ (browse-url (forge--format (forge-get-repository 'stub)
+ 'issues-url-format)))
+
+;;;###autoload
+(defun forge-browse-issue (issue)
+ "Visit the current issue using a browser.
+If there is no current issue or with a prefix argument
+read an ISSUE to visit."
+ (interactive (list (forge-read-issue "Browse issue" t)))
+ (forge-browse (forge-get-issue issue)))
+
+;;;###autoload
+(defun forge-browse-post ()
+ "Visit the current post using a browser."
+ (interactive)
+ (if-let ((post (forge-post-at-point)))
+ (forge-browse post)
+ (user-error "There is no current post")))
+
+;;; Visit
+
+;;;###autoload
+(defun forge-visit-topic (topic)
+ "View the current topic in a separate buffer.
+If there is no current topic or with a prefix argument
+read a topic to visit instead."
+ (interactive (list (if-let ((topic (forge-current-topic)))
+ (oref topic id)
+ (forge-read-topic "View topic"))))
+ (forge-visit (forge-get-topic topic)))
+
+;;;###autoload
+(defun forge-visit-pullreq (pullreq)
+ "View the current pull-request in a separate buffer.
+If there is no current pull-request or with a prefix argument
+read a PULLREQ to visit instead. If point is looking at a pullreq
+reference with Gitlab/Github notation try to visit the pullreq
+with that number."
+ (interactive (list (forge-read-pullreq "View pull-request" t)))
+ (forge-visit (forge-get-pullreq pullreq)))
+
+;;;###autoload
+(defun forge-visit-issue (issue)
+ "Visit the current issue in a separate buffer.
+If there is no current issue or with a prefix argument read an
+ISSUE to visit instead. If point is looking at an issue reference
+with Gitlab/Github notation try to visit the issue with that
+number."
+ (interactive (list (forge-read-issue "View issue" t)))
+ (forge-visit (forge-get-issue issue)))
+
+;;;###autoload
+(defun forge-visit-repository (repo)
+ "View the current repository in a separate buffer."
+ (interactive
+ (list (or (forge-current-repository)
+ (forge-get-repository
+ (forge-read-repository "Visit repository")))))
+ (forge-visit repo))
+
+;;; Create
+
+(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 t))
+ (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)))
+
+(defun forge-create-pullreq-from-issue (issue source target)
+ "Convert an existing ISSUE into a pull-request."
+ (interactive (cons (forge-read-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 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
+ (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-issue ()
+ "Create a new issue for the current repository."
+ (interactive)
+ (let* ((repo (forge-get-repository t))
+ (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-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 (or (forge-post-at-point)
+ (user-error "There is no current post")))
+ (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)))
+
+(defun forge-edit-topic-title (topic)
+ "Edit the title of the current topic.
+If there is no current topic or with a prefix argument read a
+TOPIC and modify that instead."
+ (interactive (list (forge-read-topic "Edit title of")))
+ (let ((topic (forge-get-topic topic)))
+ (forge--set-topic-title
+ (forge-get-repository topic) topic
+ (read-string "Title: " (oref topic title)))))
+
+(defun forge-edit-topic-state (topic)
+ "Close or reopen the current topic.
+If there is no current topic or with a prefix argument read a
+TOPIC and modify that instead."
+ (interactive
+ (let* ((id (forge-read-topic "Close/reopen"))
+ (topic (forge-get-topic id)))
+ (if (magit-y-or-n-p
+ (format "%s %S"
+ (cl-ecase (oref topic state)
+ (merged (error "Merged pull-requests cannot be reopened"))
+ (closed "Reopen")
+ (open "Close"))
+ (car (forge--topic-format-choice topic))))
+ (list id)
+ (user-error "Abort"))))
+ (let ((topic (forge-get-topic topic)))
+ (forge--set-topic-state (forge-get-repository topic) topic)))
+
+(defun forge-edit-topic-draft (pullreq)
+ "Toggle whether the current pull-request is a draft.
+If there is no current topic or with a prefix argument read a
+TOPIC and modify that instead."
+ (interactive (list (forge-read-pullreq "Toggle draft state of")))
+ (let ((pullreq (forge-get-pullreq pullreq)))
+ (forge--set-topic-draft (forge-get-repository pullreq)
+ pullreq
+ (not (oref pullreq draft-p)))))
+
+(defun forge-edit-topic-milestone (topic)
+ (interactive (list (forge-read-topic "Edit milestone of")))
+ (let* ((topic (forge-get-topic topic))
+ (repo (forge-get-repository topic)))
+ (forge--set-topic-milestone
+ repo topic
+ (magit-completing-read
+ "Milestone"
+ (mapcar #'caddr (oref repo milestones))
+ nil t (forge--get-topic-milestone topic)))))
+
+(defun forge-edit-topic-labels (topic)
+ "Edit the labels of the current topic.
+If there is no current topic or with a prefix argument read a
+TOPIC and modify that instead."
+ (interactive (list (forge-read-topic "Edit labels of")))
+ (let* ((topic (forge-get-topic topic))
+ (repo (forge-get-repository topic))
+ (crm-separator ","))
+ (forge--set-topic-labels
+ repo topic (magit-completing-read-multiple
+ "Labels: "
+ (mapcar #'cadr (oref repo labels))
+ nil t
+ (mapconcat #'car (closql--iref topic 'labels) ",")))))
+
+(defun forge-edit-topic-marks (topic marks)
+ "Edit the marks of the current topic.
+If there is no current topic or with a prefix argument read a
+TOPIC and modify that instead."
+ (interactive
+ (let ((topic (forge-read-topic "Edit marks of")))
+ (list topic (forge-read-marks "Marks: " (forge-get-topic topic)))))
+ (oset (forge-get-topic topic) marks marks)
+ (magit-refresh))
+
+(defun forge-edit-topic-assignees (topic)
+ "Edit the assignees of the current topic.
+If there is no current topic or with a prefix argument read a
+TOPIC and modify that instead."
+ (interactive (list (forge-read-topic "Edit assignees of")))
+ (let* ((topic (forge-get-topic topic))
+ (repo (forge-get-repository topic))
+ (value (closql--iref topic 'assignees))
+ (choices (mapcar #'cadr (oref repo assignees)))
+ (crm-separator ","))
+ (forge--set-topic-assignees
+ repo topic
+ (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-edit-topic-review-requests (pullreq)
+ "Edit the review-requests of the current pull-request.
+If there is no current topic or with a prefix argument read a
+PULLREQ and modify that instead."
+ (interactive (list (forge-read-pullreq "Request review for")))
+ (let* ((topic (forge-get-pullreq pullreq))
+ (repo (forge-get-repository topic))
+ (value (closql--iref topic 'review-requests))
+ (choices (mapcar #'cadr (oref repo assignees)))
+ (crm-separator ","))
+ (forge--set-topic-review-requests
+ repo topic
+ (magit-completing-read-multiple
+ "Request review from: " choices nil
+ 'confirm
+ (mapconcat #'car value ",")))))
+
+(defun forge-edit-topic-note (topic)
+ "Edit your private note about the current topic.
+If there is no current topic or with a prefix argument read a
+TOPIC and modify that instead."
+ (interactive (list (forge-read-topic "Edit note about")))
+ (let* ((topic (forge-get-topic topic))
+ (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
+
+(defun forge-delete-comment (comment)
+ "Delete the comment at point."
+ (interactive (list (or (forge-comment-at-point)
+ (user-error "There is no comment at point"))))
+ (when (yes-or-no-p "Do you really want to delete the selected comment? ")
+ (forge--delete-comment (forge-get-repository t) comment)))
+
+;;; 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" t)))
+ (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)
+ (magit-refresh))))
+
+(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))
+ (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 (forge--url-equal url (format "git@%s:%s.git" host fork))
+ (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" t)))
+ (magit--checkout (forge--branch-pullreq (forge-get-pullreq pullreq)))
+ (magit-refresh))
+
+;;;###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" t)))
+ (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)
+ (with-slots (number head-ref) pullreq
+ (let ((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 ((`(,id ,name ,face ,description)
+ (forge-read-mark "Edit mark")))
+ (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))
+
+(defun forge-read-mark (prompt)
+ "Read a topic. Return (ID NAME FACE DESCRIPTION)."
+ (let* ((marks (forge-sql [:select [id name face description] :from mark]))
+ (name (completing-read prompt (mapcar #'cadr marks) nil t)))
+ (--first (equal (cadr it) name) marks)))
+
+(defun forge-read-marks (prompt &optional topic)
+ "Read multiple mark names and return the respective ids."
+ (let ((marks (forge-sql [:select [name id] :from mark]))
+ (crm-separator ","))
+ (--map (cadr (assoc it marks))
+ (magit-completing-read-multiple
+ prompt (mapcar #'car marks) nil t
+ (and topic
+ (mapconcat #'car (closql--iref topic 'marks) ","))))))
+
+(defun forge-toggle-mark (mark)
+ "Toggle MARK for the current topic."
+ (if-let ((topic (forge-current-topic)))
+ (let* ((value (mapcar #'car (closql--iref topic 'marks)))
+ (value (if (member mark value)
+ (delete mark value)
+ (cons mark value)))
+ (marks (forge-sql [:select [name id] :from mark])))
+ (oset topic marks (--map (cadr (assoc it marks)) value))
+ (magit-refresh))
+ (user-error "There is no topic at point")))
+
+;;; Fork
+
+;;;###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"))))
+
+;;; Misc
+
+(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)))
+
+;;;###autoload
+(defun forge-list-notifications ()
+ "List notifications."
+ (interactive)
+ (forge-notifications-setup-buffer))
+
+(transient-define-suffix forge-toggle-display-in-status-buffer ()
+ "Toggle whether to display topics in the current status buffer."
+ :description (lambda ()
+ (if forge-display-in-status-buffer
+ "hide all topics"
+ "display topics"))
+ (interactive)
+ (setq forge-display-in-status-buffer (not forge-display-in-status-buffer))
+ (magit-refresh))
+
+(transient-define-suffix forge-toggle-closed-visibility ()
+ "Toggle whether to display recently closed topics.
+This only affect the current status buffer."
+ :description (lambda ()
+ (if (or (atom forge-topic-list-limit)
+ (> (cdr forge-topic-list-limit) 0))
+ "hide closed topics"
+ "display recently closed topics"))
+ :inapt-if-not (lambda () forge-display-in-status-buffer)
+ (interactive)
+ (magit-repository-local-delete (list 'forge-ls-recent-topics 'issue))
+ (magit-repository-local-delete (list 'forge-ls-recent-topics 'pullreq))
+ (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))))
+ (magit-refresh))
+
+(transient-define-infix forge-forge.graphqlItemLimit ()
+ "Change the maximum number of GraphQL entities to pull at once."
+ :class 'magit--git-variable
+ :variable "forge.graphqlItemLimit"
+ :reader #'read-string
+ :default (lambda () (number-to-string ghub-graphql-items-per-request)))
+
+;;;###autoload
+(defun 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."
+ (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))))
+
+;;;###autoload
+(defun forge-add-repository (url)
+ "Add a repository to the database.
+Offer to either pull topics (now and in the future) or to only
+pull individual topics when the user invokes `forge-pull-topic'."
+ (declare (interactive-only t))
+ (interactive
+ (let ((str (magit-read-string-ns
+ "Add repository to database (url or name)"
+ (and-let* ((repo (forge-get-repository 'stub))
+ (remote (oref repo remote)))
+ (magit-git-string "remote" "get-url" remote)))))
+ (if (string-match-p "\\(://\\|@\\)" str)
+ (list str)
+ (list (magit-clone--name-to-url str)))))
+ (if (forge-get-repository url nil 'full)
+ (user-error "%s is already tracked in Forge database" url)
+ (let ((repo (forge-get-repository url nil 'create)))
+ (oset repo sparse-p nil)
+ (magit-read-char-case "Pull " nil
+ (?a "[a]ll topics"
+ (forge-pull repo))
+ (?i "[i]ndividual topics (useful for casual contributors)"
+ (oset repo selective-p t)
+ (forge--pull repo nil))))))
+
+;;;###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))
+
+;;;###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" t)
+ (if (forge--childp (forge-get-repository t) '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-remove-repository (host owner name)
+ "Remove a repository from the database."
+ (interactive
+ (pcase-let ((`(,githost ,owner ,name)
+ (forge-read-repository "Remove repository from db")))
+ (if (yes-or-no-p
+ (format "Do you really want to remove \"%s/%s @%s\" from the db? "
+ owner name githost))
+ (list githost owner name)
+ (user-error "Abort"))))
+ (closql-delete (forge-get-repository (list host owner name)))
+ (magit-refresh))
+
+;;;###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))
+ (magit-refresh)))
+
+;;;###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 'full))
+ (_ (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)
+ (magit-refresh)
+ (message "Renaming default branch...done")))
+
+;;;###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)
+ (magit-refresh)))
+
+(defun forge-enable-sql-logging ()
+ "Enable logging Forge's SQL queries."
+ (interactive)
+ (let ((db (forge-db)))
+ (emacsql-enable-debugging db)
+ (switch-to-buffer-other-window (emacsql-log-buffer (oref db connection)))))
+
+(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-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonas@bernoul.li>
+;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+;; 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 '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 'owner eieio--known-slot-names)
+ (cl-pushnew 'number 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)
+ ("code.orgmode.org" "code.orgmode.org/api/v1"
+ "code.orgmode.org" forge-gogs-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 ID CLASS).
+
+GITHOST is matched against the host part of Git remote urls
+ using `forge--url-regexp' to identify the forge.
+APIHOST is the api endpoint of the forge's api.
+ID is used to identify the forge in the local database.
+CLASS is the class to be used for repository from the forge.
+
+GITHOST and APIHOST can be changed, but ID and CLASS are final.
+If you change ID, then the identity of every repository from
+that forge changes. If you change CLASS, then things start
+falling apart.
+
+There can be multiple elements that only differ in GITHOST.
+Among those, the canonical element should come first. Any
+elements that have the same APIHOST must also have the same
+ID, and vice-versa.
+
+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.
+
+* This variable does not account for the possibility that the
+ git repository does not use the same address as the web
+ interface. That is another historic accident and if many
+ users are affected by it, we might have to fix it properly.
+ If you would like that, comment on issue #532.
+
+ For now a workaround has to be used. Assuming the web
+ interface is available at \"example.com\" and the repository
+ is at \"ssh.example.com\", use \"example.com\" as GITHOST and
+ add something like this to \".gitconfig\":
+
+ [url \"gitNOSPAMssh.example.com\"]
+ insteadOf = gitNOSPAMexample.com"
+ :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"))))
+
+(defcustom forge-pull-notifications nil
+ "Whether `forge-pull' also fetches notifications.
+If this is nil, then `forge-pull-notifications' has to be used."
+ :package-version '(forge . "0.2.0")
+ :group 'forge
+ :type 'boolean)
+
+;;; Core
+
+(defclass forge-object (closql-object) () :abstract t)
+
+(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.
+
+The DEMAND argument controls what to do when the object isn't
+stored in the database yet, or if it is marked as sparse. The
+valid values are:
+
+* `nil' If the repository is stored in the database then return
+ it, even if it is sparse. Otherwise return nil.
+
+* `t' If the repository isn't stored in the database or if the
+ object is sparse, then signal an error, informing the user
+ that `this-command' cannot be run until the repository has
+ been pulled.
+
+* `full' If the repository is stored in the database and the
+ object isn't sparse, then return it. Otherwise return nil.
+
+* `stub' If the repository is stored in the database, then return
+ it, regardless of whether it is sparse or not. Otherwise create
+ a new object and return it, but do not store it in the database.
+ In the latter case it is assumed that the caller does not need
+ the `id' and `forge-id' slots whose value differ from what they
+ would be if the object were retrieved from the database.
+
+* `create' This value is only intended to be used by commands
+ that fetch data from the API. If the repository is stored in
+ the database, then return that, regardless of whether the
+ object is sparse or not. If the repository is not stored in the
+ database, then make an API request to determine the ID used on
+ the forge, derive our own ID from that, and store a new sparse
+ object in the database and return it.
+
+If DEMAND is t, `stub' or `create', then also signal an error if
+the repository cannot be determined because there is no matching
+entry in `forge-alist'.
+
+Also update the object's `apihost', `githost' and `remote' slots
+according to the respective entry in `forge-alist' and the REMOTE
+argument.
+
+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.")
+
+(cl-defgeneric forge-get-url (obj)
+ "Return the URL for a forge object.")
+
+(cl-defgeneric forge-browse (obj)
+ "Visit the URL corresponding to a forge object in a browser."
+ (browse-url (forge-get-url obj)))
+
+(cl-defgeneric forge-visit (obj)
+ "View a forge object in a separate buffer.")
+
+(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)
+ "Return the database and forge ids for the specified CLASS object.")
+
+(cl-defmethod magit-section-ident-value ((obj forge-object))
+ (oref obj id))
+
+;;; Utilities
+
+(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))))
+
+(defun forge--set-id-slot (repo object slot rows)
+ (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))))
+
+(cl-defgeneric forge--format (object slot &optional spec))
+
+(cl-defmethod forge--format ((remote string) slot &optional spec)
+ (if-let ((parts (forge--split-remote-url remote)))
+ (forge--format
+ (forge-get-repository 'stub remote) slot
+ (pcase-let* ((`(,host ,owner ,name) parts)
+ (path (if owner (concat owner "/" name) name)))
+ `(,@spec
+ (?h . ,host)
+ (?o . ,owner)
+ (?n . ,name)
+ (?p . ,path)
+ (?P . ,(string-replace "/" "%2F" path)))))
+ (user-error "Cannot browse non-forge remote %s" remote)))
+
+(defun forge--url-regexp ()
+ (concat "\\`\\(?:git://\\|"
+ "[^/@]+@\\|"
+ "\\(?:ssh\\|ssh\\+git\\|git\\+ssh\\)://\\(?:[^/@]+@\\)?\\|"
+ "https?://\\(?:[^/@]+@\\)?\\)?"
+ (regexp-opt (mapcar #'car forge-alist) t)
+ "\\(?::[0-9]+\\)?"
+ "\\(?:/\\|:/?\\)"
+ "\\(.+?\\)"
+ "\\(?:\\.git\\|/\\)?\\'"))
+
+(defun forge--split-remote-url (remote)
+ (and-let* ((url (magit-git-string "remote" "get-url" remote)))
+ (forge--split-url url)))
+
+(defun forge--split-url (url)
+ (and (string-match (forge--url-regexp) url)
+ (and-let* ((host (match-string 1 url))
+ (path (match-string 2 url))
+ (path (forge--split-url-path
+ (nth 3 (assoc host forge-alist))
+ path)))
+ (cons host path))))
+
+(cl-defmethod forge--split-url-path
+ ((_class (subclass forge-repository)) path)
+ (and (string-match "\\`\\([^/]+\\)/\\([^/]+?\\)\\'" path)
+ (list (match-string 1 path)
+ (match-string 2 path))))
+
+(cl-defmethod forge--split-url-path
+ ((_class (subclass forge-noapi-repository)) path)
+ (and (string-match "\\`\\(?:~?\\(.+\\)/\\)?\\([^/]+?\\)\\'" path)
+ (list (match-string 1 path)
+ (match-string 2 path))))
+
+(defun forge--url-p (url)
+ (save-match-data
+ (and (string-match (forge--url-regexp) url)
+ (nth 2 (assoc (match-string 1 url) forge-alist)))))
+
+(defun forge--forge-remote-p (remote)
+ (and-let* ((url (magit-git-string "remote" "get-url" remote)))
+ (forge--url-p url)))
+
+(defun forge--url-equal (urlA urlB)
+ (or (equal urlA urlB)
+ (save-match-data
+ (let ((re (forge--url-regexp))
+ hostA repoA hostB repoB)
+ (and (when (string-match re urlA)
+ (setq hostA (match-string 1 urlA))
+ (setq repoA (match-string 2 urlA)))
+ (when (string-match re urlB)
+ (setq hostB (match-string 1 urlB))
+ (setq repoB (match-string 2 urlB)))
+ (equal repoA repoB)
+ (equal (cl-caddr (assoc hostA forge-alist))
+ (cl-caddr (assoc hostB forge-alist))))))))
+
+(cl-defmethod forge--format-resource ((object forge-object) resource)
+ (save-match-data
+ (setq resource
+ (replace-regexp-in-string
+ ":\\([^/]+\\)"
+ (lambda (str)
+ (let ((slot (intern (substring str 1))))
+ (or (and-let*
+ ((v (ignore-errors
+ (cl-case 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)))
+ (t (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)))
+
+;; This is a copy of `org-id-uuid'.
+(defun forge--uuid ()
+ "Return string with random (version 4) UUID."
+ (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-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+;; 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-get-issue "forge-core")
+(declare-function forge-get-pullreq "forge-core")
+(declare-function forge--object-id "forge-core")
+
+(eval-when-compile
+ (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 9)))
+
+(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)
+
+;;; Schemata
+
+(defconst forge--db-table-schemata
+ '((repository
+ [(class :not-null)
+ (id :not-null :primary-key)
+ forge-id
+ forge
+ owner
+ name
+ apihost
+ githost
+ remote
+ sparse-p
+ 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)])
+
+ (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
+ unread-p
+ 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]
+ (: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
+ forge
+ reason
+ unread-p
+ last-read
+ updated
+ title
+ type
+ topic
+ url]
+ (: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
+ unread-p
+ 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]
+ (: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")))
+ (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-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+;; 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-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+;; 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/*")))
+
+;;; Pull
+;;;; Repository
+
+(cl-defmethod forge--pull ((repo forge-github-repository) until
+ &optional callback)
+ (let ((buf (current-buffer))
+ (dir default-directory)
+ (selective-p (oref repo selective-p))
+ (ghub-graphql-items-per-request
+ (string-to-number
+ (or (magit-get "forge.graphqlItemLimit") "100"))))
+ (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 sparse-p nil))
+ (forge--msg repo t t "Storing REPO")
+ (cond
+ (selective-p)
+ (callback (funcall callback))
+ (forge-pull-notifications
+ (forge--pull-notifications (eieio-object-class repo)
+ (oref repo githost)
+ (lambda () (forge--git-fetch buf dir repo))))
+ (t (forge--git-fetch buf dir repo))))
+ `((issues-until . ,(forge--topics-until repo until 'issue))
+ (pullRequests-until . ,(forge--topics-until repo until 'pullreq)))
+ :host (oref repo apihost)
+ :auth 'forge
+ :sparse selective-p)))
+
+(cl-defmethod forge--pull-topic ((repo forge-github-repository)
+ (topic forge-topic))
+ (let ((buffer (current-buffer))
+ (fetch #'ghub-fetch-issue)
+ (update #'forge--update-issue)
+ (errorback (lambda (err _headers _status _req)
+ (when (equal (cdr (assq 'type (cadr err))) "NOT_FOUND")
+ (forge--pull-topic
+ repo (forge-pullreq :repository (oref repo id)
+ :number (oref topic number)))))))
+ (when (cl-typep topic 'forge-pullreq)
+ (setq fetch #'ghub-fetch-pullreq)
+ (setq update #'forge--update-pullreq)
+ (setq errorback nil))
+ (funcall
+ fetch
+ (oref repo owner)
+ (oref repo name)
+ (oref topic number)
+ (lambda (data)
+ (funcall update repo data nil)
+ (with-current-buffer
+ (if (buffer-live-p buffer) buffer (current-buffer))
+ (magit-refresh)))
+ nil
+ :errorback errorback
+ :host (oref repo apihost)
+ :auth 'forge)))
+
+(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-issues ((repo forge-github-repository) data bump)
+ (closql-with-transaction (forge-db)
+ (mapc (lambda (e) (forge--update-issue repo e bump)) data)))
+
+(cl-defmethod forge--update-issue ((repo forge-github-repository) data bump)
+ (closql-with-transaction (forge-db)
+ (let-alist data
+ (let* ((issue-id (forge--object-id 'forge-issue repo .number))
+ (issue (or (forge-get-issue repo .number)
+ (closql-insert
+ (forge-db)
+ (forge-issue :id issue-id
+ :repository (oref repo id)
+ :number .number)))))
+ (oset issue id issue-id)
+ (oset issue their-id .id)
+ (oset issue state (pcase-exhaustive .state
+ ("CLOSED" 'closed)
+ ("OPEN" 'open)))
+ (oset issue author .author.login)
+ (oset issue title .title)
+ (oset issue created .createdAt)
+ (oset issue updated (cond (bump (or .updatedAt .createdAt))
+ ((slot-boundp issue 'updated)
+ (oref issue updated))
+ (t "0")))
+ (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))
+ .databaseId ; Silence Emacs 25 byte-compiler.
+ (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)))
+ (when bump
+ (forge--set-id-slot repo issue 'assignees .assignees)
+ (unless (magit-get-boolean "forge.kludge-for-issue-294")
+ (forge--set-id-slot repo issue 'labels .labels)))
+ issue))))
+
+(cl-defmethod forge--update-pullreqs ((repo forge-github-repository) data bump)
+ (closql-with-transaction (forge-db)
+ (mapc (lambda (e) (forge--update-pullreq repo e bump)) data)))
+
+(cl-defmethod forge--update-pullreq ((repo forge-github-repository) data bump)
+ (closql-with-transaction (forge-db)
+ (let-alist data
+ (let* ((pullreq-id (forge--object-id 'forge-pullreq repo .number))
+ (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 state (pcase-exhaustive .state
+ ("MERGED" 'merged)
+ ("CLOSED" 'closed)
+ ("OPEN" 'open)))
+ (oset pullreq author .author.login)
+ (oset pullreq title .title)
+ (oset pullreq created .createdAt)
+ (oset pullreq updated (cond (bump (or .updatedAt .createdAt))
+ ((slot-boundp pullreq 'updated)
+ (oref pullreq updated))
+ (t "0")))
+ (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))
+ .databaseId ; Silence Emacs 25 byte-compiler.
+ (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)))
+ (when bump
+ (forge--set-id-slot repo pullreq 'assignees .assignees)
+ (forge--set-id-slot repo pullreq 'review-requests
+ (--map (cdr (cadr (car it)))
+ .reviewRequests))
+ (unless (magit-get-boolean "forge.kludge-for-issue-294")
+ (forge--set-id-slot repo pullreq 'labels .labels)))
+ pullreq))))
+
+(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)))))
+
+;;;; 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 (assoc githost forge-alist)))
+ (unless spec
+ (error "No entry for %S in forge-alist" githost))
+ (forge--msg nil t nil "Pulling notifications")
+ (pcase-let*
+ ((`(,_ ,apihost ,forge ,_) spec)
+ (notifs (-keep (lambda (data)
+ ;; Github may return notifications for repos
+ ;; the user no longer has access to. Trying
+ ;; to retrieve information for such a repo
+ ;; leads to an error, which we suppress. See #164.
+ (with-demoted-errors "forge--pull-notifications: %S"
+ (forge--ghub-massage-notification
+ data forge githost)))
+ (forge--ghub-get nil "/notifications"
+ '((all . nil))
+ :host apihost :unpaginate t)))
+ (groups (-partition-all 50 notifs))
+ (pages (length groups))
+ (page 0)
+ (result nil))
+ (cl-labels
+ ((cb (&optional data _headers _status _req)
+ (when data
+ (setq result (nconc result (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 (-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")
+ (closql-with-transaction (forge-db)
+ (forge-sql [:delete-from notification
+ :where (= forge $s1)] forge)
+ (pcase-dolist (`(,key ,repo ,query ,obj) notifs)
+ (closql-insert (forge-db) obj)
+ (forge--zap-repository-cache (forge-get-repository obj))
+ (when query
+ (oset (funcall (if (eq (oref obj type) 'issue)
+ #'forge--update-issue
+ #'forge--update-pullreq)
+ repo (cdr (cadr (assq key result))) nil)
+ unread-p (oref obj unread-p)))))
+ (forge--msg nil t t "Storing notifications")
+ (when callback
+ (funcall callback)))))
+ (cb)))))
+
+(defun forge--ghub-massage-notification (data forge 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 'create))
+ (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 repo
+ `((,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)))
+ ))))
+ (forge-notification
+ :id id
+ :thread-id .id
+ :repository repoid
+ :forge forge
+ :reason (intern (downcase .reason))
+ :unread-p .unread
+ :last-read .last_read_at
+ :updated .updated_at
+ :title .subject.title
+ :type type
+ :topic number
+ :url .subject.url)))))))
+
+(cl-defmethod forge-topic-mark-read ((_ forge-github-repository) topic)
+ (when (oref topic unread-p)
+ (oset topic unread-p nil)
+ (when-let ((notif (forge-get-notification topic)))
+ (oset topic unread-p nil)
+ (forge--ghub-patch notif "/notifications/threads/:thread-id"))))
+
+;;;; 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 'create)))
+ (and (oref repo sparse-p)
+ (list repo))))
+ names))
+ cb)
+ (setq cb (lambda ()
+ (when-let ((repo (pop repos)))
+ (message "Adding %s..." (oref repo name))
+ (forge--pull repo nil cb))))
+ (funcall cb)))
+
+;;; Mutations
+
+(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-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--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)))
+
+(cl-defmethod forge--set-topic-state
+ ((_repo forge-github-repository) topic)
+ (forge--ghub-patch topic
+ "/repos/:owner/:repo/issues/:number"
+ `((state . ,(cl-ecase (oref topic state)
+ (closed "OPEN")
+ (open "CLOSED"))))
+ :callback (forge--set-field-callback)))
+
+(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)
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (magit-refresh-buffer))))))))
+
+(cl-defmethod forge--set-topic-milestone
+ ((repo forge-github-repository) topic milestone)
+ (forge--ghub-patch topic
+ "/repos/:owner/:repo/issues/:number"
+ `((milestone
+ . ,(caar (forge-sql [:select [number]
+ :from milestone
+ :where (and (= repository $s1)
+ (= title $s2))]
+ (oref repo id)
+ milestone))))
+ :callback (forge--set-field-callback)))
+
+(cl-defmethod forge--set-topic-labels
+ ((_repo forge-github-repository) topic labels)
+ (forge--ghub-put topic "/repos/:owner/:repo/issues/:number/labels" nil
+ :payload labels
+ :callback (forge--set-field-callback)))
+
+(cl-defmethod forge--set-topic-assignees
+ ((_repo forge-github-repository) topic assignees)
+ (let ((value (mapcar #'car (closql--iref topic 'assignees))))
+ (when-let ((add (cl-set-difference assignees value :test #'equal)))
+ (forge--ghub-post topic "/repos/:owner/:repo/issues/:number/assignees"
+ `((assignees . ,add))))
+ (when-let ((remove (cl-set-difference value assignees :test #'equal)))
+ (forge--ghub-delete topic "/repos/:owner/:repo/issues/:number/assignees"
+ `((assignees . ,remove)))))
+ (forge-pull))
+
+(cl-defmethod forge--set-topic-review-requests
+ ((_repo forge-github-repository) topic reviewers)
+ (let ((value (mapcar #'car (closql--iref topic 'review-requests))))
+ (when-let ((add (cl-set-difference reviewers value :test #'equal)))
+ (forge--ghub-post topic
+ "/repos/:owner/:repo/pulls/:number/requested_reviewers"
+ `((reviewers . ,add))))
+ (when-let ((remove (cl-set-difference value reviewers :test #'equal)))
+ (forge--ghub-delete topic
+ "/repos/:owner/:repo/pulls/:number/requested_reviewers"
+ `((reviewers . ,remove)))))
+ (forge-pull))
+
+(cl-defmethod forge--delete-comment
+ ((_repo forge-github-repository) post)
+ (forge--ghub-delete post "/repos/:owner/:repo/issues/comments/:number")
+ (closql-delete post)
+ (magit-refresh))
+
+(cl-defmethod forge--topic-templates ((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-templates ((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))))))
+
+;;; Utilities
+
+(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-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+;; 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) until)
+ (let ((cb (let ((buf (and (derived-mode-p 'magit-mode)
+ (current-buffer)))
+ (dir default-directory)
+ (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 until))
+ ((and .merge_requests_enabled
+ (not (assq 'pullreqs val)))
+ (forge--fetch-pullreqs repo cb until))
+ (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 sparse-p nil))
+ (forge--msg repo t t "Storing REPO")
+ (unless (oref repo selective-p)
+ (forge--git-fetch buf dir repo)))))))))
+ (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)))
+
+(cl-defmethod forge--split-url-path
+ ((_class (subclass forge-gitlab-repository)) path)
+ (and (string-match "\\`\\(?:~?\\(.+\\)/\\)?\\([^/]+?\\)\\'" path)
+ (list (match-string 1 path)
+ (match-string 2 path))))
+
+;;;; Issues
+
+(cl-defmethod forge--fetch-issues ((repo forge-gitlab-repository) callback until)
+ (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 (forge--topics-until repo until 'issue)))
+ `((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
+ :repository (oref repo id)
+ :state (pcase-exhaustive .state
+ ("closed" 'closed)
+ ("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 slots
+ ;; 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))
+ .body .id ; Silence Emacs 25 byte-compiler.
+ (dolist (c .notes)
+ (let-alist c
+ (let ((post
+ (forge-issue-post
+ :id (forge--object-id issue-id .id)
+ :issue issue-id
+ :number .id
+ :author .author.username
+ :created .created_at
+ :updated .updated_at
+ :body (forge--sanitize-string .body))))
+ (closql-insert (forge-db) post t))))))))
+
+;;;; Pullreqs
+
+(cl-defmethod forge--fetch-pullreqs ((repo forge-gitlab-repository) callback until)
+ (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 (forge--topics-until repo until 'pullreq)))
+ `((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
+ :repository (oref repo id)
+ :state (pcase-exhaustive .state
+ ("merged" 'merged)
+ ("closed" 'closed)
+ ("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))
+ .body .id ; Silence Emacs 25 byte-compiler.
+ (dolist (c .notes)
+ (let-alist c
+ (let ((post
+ (forge-pullreq-post
+ :id (forge--object-id pullreq-id .id)
+ :pullreq pullreq-id
+ :number .id
+ :author .author.username
+ :created .created_at
+ :updated .updated_at
+ :body (forge--sanitize-string .body))))
+ (closql-insert (forge-db) post t))))))))
+
+;;;; 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-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-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-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)))
+
+(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)
+ (forge--set-topic-field repo topic 'state_event
+ (cl-ecase (oref topic state)
+ (closed "reopen")
+ (open "close"))))
+
+(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)
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (magit-refresh-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)
+ (magit-refresh))
+
+(cl-defmethod forge--topic-templates ((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-templates ((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))))))
+
+;;; Utilities
+
+(cl-defmethod forge--topic-type-prefix ((_repo forge-gitlab-repository) type)
+ (if (eq type 'pullreq) "!" "#"))
+
+(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-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+;; 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-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+;; 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)
+ (closed :initarg :closed)
+ (unread-p :initarg :unread-p :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)
+ ))
+
+(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
+
+(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 t)))
+ (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))
+
+(cl-defmethod forge-ls-issues ((repo forge-repository) &optional type select)
+ (forge-ls-topics repo 'forge-issue type select))
+
+;;; Utilities
+
+(defun forge-read-issue (prompt &optional type)
+ (when (eq type t)
+ (setq type (if current-prefix-arg nil 'open)))
+ (let* ((default (forge-current-issue))
+ (repo (forge-get-repository (or default t)))
+ (choices (mapcar
+ (apply-partially #'forge--topic-format-choice repo)
+ (forge-ls-issues repo type [number title id class]))))
+ (cdr (assoc (magit-completing-read
+ prompt choices nil nil nil nil
+ (and default
+ (setq default (forge--topic-format-choice default))
+ (member default choices)
+ (car default)))
+ choices))))
+
+(cl-defmethod forge-get-url ((issue forge-issue))
+ (forge--format issue 'issue-url-format))
+
+(defun forge--issue-by-forge-short-link-at-point ()
+ (forge--topic-by-forge-short-link-at-point '("#") #'forge-get-issue))
+
+;;; Sections
+
+(defun forge-current-issue ()
+ (or (forge-issue-at-point)
+ (and (derived-mode-p 'forge-topic-mode)
+ (forge-issue-p forge-buffer-topic)
+ forge-buffer-topic)
+ (and (derived-mode-p 'forge-topic-list-mode)
+ (let ((topic (forge-get-topic (tabulated-list-get-id))))
+ (and (forge-issue-p topic)
+ topic)))))
+
+(defun forge-issue-at-point ()
+ (or (magit-section-value-if 'issue)
+ (and-let* ((post (magit-section-value-if 'post)))
+ (cond ((forge-issue-p post)
+ post)
+ ((forge-issue-post-p post)
+ (forge-get-issue post))))
+ (forge--issue-by-forge-short-link-at-point)))
+
+(defvar-keymap forge-issues-section-map
+ "<remap> <magit-browse-thing>" #'forge-browse-issues
+ "<remap> <magit-visit-thing>" #'forge-list-issues
+ "C-c C-n" #'forge-create-issue)
+
+(defvar-keymap forge-issue-section-map
+ "<remap> <magit-browse-thing>" #'forge-browse-issue
+ "<remap> <magit-visit-thing>" #'forge-visit-issue)
+
+(defun forge-insert-issues ()
+ "Insert a list of mostly recent and/or open issues.
+Also see option `forge-topic-list-limit'."
+ (when (and forge-display-in-status-buffer (forge-db t))
+ (when-let ((repo (forge-get-repository nil)))
+ (when (and (not (oref repo sparse-p))
+ (or (not (slot-boundp repo 'issues-p)) ; temporary KLUDGE
+ (oref repo issues-p)))
+ (forge-insert-topics "Issues"
+ (forge-ls-recent-topics repo 'issue)
+ (forge--topic-type-prefix repo 'issue))))))
+
+(defun forge-insert-assigned-issues ()
+ "Insert a list of open issues that are assigned to you."
+ (when forge-display-in-status-buffer
+ (when-let ((repo (forge-get-repository nil)))
+ (unless (oref repo sparse-p)
+ (forge-insert-topics "Assigned issues"
+ (forge--ls-assigned-issues repo)
+ (forge--topic-type-prefix repo 'issue))))))
+
+(defun forge--ls-assigned-issues (repo)
+ (mapcar (lambda (row)
+ (closql--remake-instance 'forge-issue (forge-db) row))
+ (forge-sql
+ [:select $i1 :from [issue issue_assignee assignee]
+ :where (and (= issue_assignee:issue issue:id)
+ (= issue_assignee:id assignee:id)
+ (= issue:repository $s2)
+ (= assignee:login $s3)
+ (isnull issue:closed))
+ :order-by [(desc updated)]]
+ (vconcat (closql--table-columns (forge-db) 'issue t))
+ (oref repo id)
+ (ghub--username repo))))
+
+(defun forge-insert-authored-issues ()
+ "Insert a list of open issues that are authored to you."
+ (when forge-display-in-status-buffer
+ (when-let ((repo (forge-get-repository nil)))
+ (unless (oref repo sparse-p)
+ (forge-insert-topics "Authored issues"
+ (forge--ls-authored-issues repo)
+ (forge--topic-type-prefix repo 'issue))))))
+
+(defun forge--ls-authored-issues (repo)
+ (mapcar (lambda (row)
+ (closql--remake-instance 'forge-issue (forge-db) row))
+ (forge-sql
+ [:select $i1 :from [issue]
+ :where (and (= issue:repository $s2)
+ (= issue:author $s3)
+ (isnull issue:closed))
+ :order-by [(desc updated)]]
+ (vconcat (closql--table-columns (forge-db) 'issue t))
+ (oref repo id)
+ (ghub--username repo))))
+
+;;; _
+(provide 'forge-issue)
+;;; forge-issue.el ends here
--- /dev/null
+;;; forge-list.el --- Tabulated-list interface -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+;; 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)
+
+(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))
+
+(defvar forge-topic-list-columns
+ '(("#" 5 forge-topic-list-sort-by-number (:right-align t) number nil)
+ ("Title" 35 t nil title nil)
+ ))
+
+(defvar forge-global-topic-list-columns
+ '(("Owner" 15 t nil repository:owner nil)
+ ("Name" 20 t nil repository:name nil)
+ ("#" 5 forge-topic-list-sort-by-number (:right-align t) number nil)
+ ("Title" 35 t nil title nil)
+ ))
+
+(defvar forge-repository-list-columns
+ '(("Owner" 20 t nil owner nil)
+ ("Name" 20 t nil name nil)
+ ("N" 1 t nil sparse-p nil)
+ ("S" 1 t nil selective-p nil)
+ ("Worktree" 99 t nil worktree nil)
+ ))
+
+(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)))
+
+(define-obsolete-variable-alias 'forge-owned-blacklist
+ 'forge-owned-ignored "Forge 3.0.0")
+
+(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")))
+
+;;; Variables
+
+(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)
+
+;;; Modes
+;;;; Topics
+
+(defvar-keymap forge-topic-list-mode-map
+ :doc "Local keymap for Forge-Topic-List mode buffers."
+ :parent tabulated-list-mode-map
+ "RET" #'forge-visit-topic
+ "<return>" #'forge-visit-topic
+ "o" #'forge-browse-topic
+ "'" #'forge-dispatch
+ "?" #'magit-dispatch)
+
+(define-derived-mode forge-topic-list-mode tabulated-list-mode
+ "Issues"
+ "Major mode for browsing a list of topics."
+ (setq-local x-stretch-cursor nil)
+ (setq tabulated-list-padding 0)
+ (setq tabulated-list-sort-key (cons "#" nil)))
+
+(define-derived-mode forge-issue-list-mode forge-topic-list-mode
+ "Issues"
+ "Major mode for browsing a list of issues.")
+
+(define-derived-mode forge-pullreq-list-mode forge-topic-list-mode
+ "Pull-Requests"
+ "Major mode for browsing a list of pull-requests.")
+
+(defun forge-topic-list-setup (mode id buffer-name columns fn)
+ (declare (indent 4))
+ (let* ((repo (forge-get-repository (list :id id)))
+ (topdir (magit-toplevel)))
+ (with-current-buffer
+ (get-buffer-create
+ (or buffer-name
+ (format "*%s: %s/%s*"
+ (substring (symbol-name mode) 0 -5)
+ (oref repo owner)
+ (oref repo name))))
+ (setq forge--tabulated-list-columns (or columns forge-topic-list-columns))
+ (setq forge--tabulated-list-query fn)
+ (setq forge-buffer-repository repo)
+ (when topdir
+ (setq default-directory topdir))
+ (cl-letf (((symbol-function #'tabulated-list-revert) #'ignore)) ; see #229
+ (funcall mode))
+ (forge-topic-list-refresh)
+ (add-hook 'tabulated-list-revert-hook
+ #'forge-topic-list-refresh nil t)
+ (tabulated-list-init-header)
+ (tabulated-list-print)
+ (switch-to-buffer (current-buffer)))))
+
+(defun forge-topic-list-refresh ()
+ (setq tabulated-list-format
+ (vconcat (--map `(,@(-take 3 it)
+ ,@(-flatten (nth 3 it)))
+ forge--tabulated-list-columns)))
+ (tabulated-list-init-header)
+ (setq tabulated-list-entries
+ (mapcar #'forge--tablist-format-entry
+ (funcall forge--tabulated-list-query))))
+
+;;;; Repository
+
+(defvar-keymap forge-repository-list-mode-map
+ :doc "Local keymap for Forge-Repository-List mode buffers."
+ :parent tabulated-list-mode-map
+ "RET" #'forge-visit-repository
+ "<return>" #'forge-visit-repository
+ "o" #'forge-browse-repository
+ "'" #'forge-dispatch
+ "?" #'magit-dispatch)
+
+(define-derived-mode forge-repository-list-mode tabulated-list-mode
+ "Repositories"
+ "Major mode for browsing a list of repositories."
+ (setq-local x-stretch-cursor nil)
+ (setq forge--tabulated-list-columns forge-repository-list-columns)
+ (setq tabulated-list-padding 0)
+ (setq tabulated-list-sort-key (cons "Owner" nil))
+ (setq tabulated-list-format
+ (vconcat (--map `(,@(-take 3 it)
+ ,@(-flatten (nth 3 it)))
+ forge-repository-list-columns)))
+ (tabulated-list-init-header))
+
+(defun forge-repository-list-setup (fn buf)
+ (with-current-buffer (get-buffer-create buf)
+ (cl-letf (((symbol-function #'tabulated-list-revert) #'ignore)) ; see #229
+ (forge-repository-list-mode))
+ (funcall fn)
+ (add-hook 'tabulated-list-revert-hook fn nil t)
+ (tabulated-list-print)
+ (switch-to-buffer (current-buffer))))
+
+(defun forge-repository-list-refresh ()
+ (setq tabulated-list-entries
+ (mapcar #'forge--tablist-format-entry
+ (forge-sql [:select $i1 :from repository
+ :order-by [(asc owner) (asc name)]]
+ (forge--tablist-columns-vector)))))
+
+(defun forge-repository-list-owned-refresh ()
+ (setq tabulated-list-entries
+ (mapcar #'forge--tablist-format-entry
+ (forge-sql [:select $i1 :from repository
+ :where (and (in owner $v2)
+ (not (in name $v3)))
+ :order-by [(asc owner) (asc name)]]
+ (forge--tablist-columns-vector)
+ (vconcat (mapcar #'car forge-owned-accounts))
+ (vconcat forge-owned-ignored)))))
+
+;;; Commands
+;;;; Topic
+
+;;;###autoload
+(defun forge-list-topics (id)
+ "List topics of the current repository in a separate buffer."
+ (interactive (list (oref (forge-get-repository t) id)))
+ (forge-topic-list-setup #'forge-topic-list-mode id nil nil
+ (lambda ()
+ (forge-sql [:select $i1 :from issue :where (= repository $s2) :union
+ :select $i1 :from pullreq :where (= repository $s2)]
+ (forge--tablist-columns-vector)
+ id))))
+
+;;;; Issue
+
+;;;###autoload
+(defun forge-list-issues (id)
+ "List issues of the current repository in a separate buffer."
+ (interactive (list (oref (forge-get-repository t) id)))
+ (forge-topic-list-setup #'forge-issue-list-mode id nil nil
+ (lambda ()
+ (forge-sql [:select $i1 :from issue :where (= repository $s2)]
+ (forge--tablist-columns-vector)
+ id))))
+
+;;;###autoload
+(defun forge-list-labeled-issues (id label)
+ "List issues of the current repository that have LABEL.
+List them in a separate buffer."
+ (interactive (list (oref (forge-get-repository t) id)
+ (magit-completing-read
+ "Label"
+ (mapcar #'cadr (oref (forge-get-repository t) labels))
+ nil t)))
+ (forge-topic-list-setup #'forge-issue-list-mode id nil nil
+ (lambda ()
+ (forge-sql [:select $i1 :from [issue issue_label label]
+ :where (and (= issue_label:issue issue:id)
+ (= issue_label:id label:id)
+ (= issue:repository $s2)
+ (= label:name $s3)
+ (isnull issue:closed))
+ :order-by [(desc updated)]]
+ (forge--tablist-columns-vector 'issue)
+ id label))))
+
+;;;###autoload
+(defun forge-list-assigned-issues (id)
+ "List issues of the current repository that are assigned to you.
+List them in a separate buffer."
+ (interactive (list (oref (forge-get-repository t) id)))
+ (forge-topic-list-setup #'forge-issue-list-mode id nil nil
+ (lambda ()
+ (forge-sql [:select $i1 :from [issue issue_assignee assignee]
+ :where (and (= issue_assignee:issue issue:id)
+ (= issue_assignee:id assignee:id)
+ (= issue:repository $s2)
+ (= assignee:login $s3)
+ (isnull issue:closed))
+ :order-by [(desc updated)]]
+ (forge--tablist-columns-vector 'issue)
+ id (ghub--username (forge-get-repository (list :id id)))))))
+
+;;;###autoload
+(defun 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."
+ (interactive)
+ (forge-topic-list-setup #'forge-issue-list-mode nil "My issues"
+ forge-global-topic-list-columns
+ (lambda ()
+ (forge-sql [:select $i1 :from [issue repository]
+ :where (and (= issue:repository repository:id)
+ (in repository:owner $v2)
+ (not (in repository:name $v3))
+ (isnull issue:closed))
+ :order-by [(asc repository:owner)
+ (asc repository:name)
+ (desc issue:number)]]
+ (forge--tablist-columns-vector 'issue)
+ (vconcat (mapcar #'car forge-owned-accounts))
+ (vconcat forge-owned-ignored)))))
+
+;;;; Pullreq
+
+;;;###autoload
+(defun forge-list-pullreqs (id)
+ "List pull-requests of the current repository in a separate buffer."
+ (interactive (list (oref (forge-get-repository t) id)))
+ (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil
+ (lambda ()
+ (forge-sql [:select $i1 :from pullreq :where (= repository $s2)]
+ (forge--tablist-columns-vector)
+ id))))
+
+;;;###autoload
+(defun forge-list-labeled-pullreqs (id label)
+ "List pull-requests of the current repository that have LABEL.
+List them in a separate buffer."
+ (interactive (list (oref (forge-get-repository t) id)
+ (magit-completing-read
+ "Label"
+ (mapcar #'cadr (oref (forge-get-repository t) labels))
+ nil t)))
+ (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil
+ (lambda ()
+ (forge-sql [:select $i1 :from [pullreq pullreq_label label]
+ :where (and (= pullreq_label:pullreq pullreq:id)
+ (= pullreq_label:id label:id)
+ (= pullreq:repository $s2)
+ (= label:name $s3)
+ (isnull pullreq:closed))
+ :order-by [(desc updated)]]
+ (forge--tablist-columns-vector 'pullreq)
+ id label))))
+
+;;;###autoload
+(defun forge-list-assigned-pullreqs (id)
+ "List pull-requests of the current repository that are assigned to you.
+List them in a separate buffer."
+ (interactive (list (oref (forge-get-repository t) id)))
+ (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil
+ (lambda ()
+ (forge-sql [:select $i1 :from [pullreq pullreq_assignee assignee]
+ :where (and (= pullreq_assignee:pullreq pullreq:id)
+ (= pullreq_assignee:id assignee:id)
+ (= pullreq:repository $s2)
+ (= assignee:login $s3)
+ (isnull pullreq:closed))
+ :order-by [(desc updated)]]
+ (forge--tablist-columns-vector 'pullreq)
+ id (ghub--username (forge-get-repository (list :id id)))))))
+
+;;;###autoload
+(defun forge-list-requested-reviews (id)
+ "List pull-requests of the current repository that are awaiting your review.
+List them in a separate buffer."
+ (interactive (list (oref (forge-get-repository t) id)))
+ (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil
+ (lambda ()
+ (forge-sql [:select $i1 :from [pullreq pullreq_review_request assignee]
+ :where (and (= pullreq_review_request:pullreq pullreq:id)
+ (= pullreq_review_request:id assignee:id)
+ (= pullreq:repository $s2)
+ (= assignee:login $s3)
+ (isnull pullreq:closed))
+ :order-by [(desc updated)]]
+ (forge--tablist-columns-vector 'pullreq)
+ id (ghub--username (forge-get-repository (list :id id)))))))
+
+;;;###autoload
+(defun 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."
+ (interactive)
+ (forge-topic-list-setup #'forge-pullreq-list-mode nil "My pullreqs"
+ forge-global-topic-list-columns
+ (lambda ()
+ (forge-sql [:select $i1 :from [pullreq repository]
+ :where (and (= pullreq:repository repository:id)
+ (in repository:owner $v2)
+ (not (in repository:name $v3))
+ (isnull pullreq:closed))
+ :order-by [(asc repository:owner)
+ (asc repository:name)
+ (desc pullreq:number)]]
+ (forge--tablist-columns-vector 'pullreq)
+ (vconcat (mapcar #'car forge-owned-accounts))
+ (vconcat forge-owned-ignored)))))
+
+;;;###autoload
+(defun forge-list-authored-pullreqs (id)
+ "List open pull-requests of the current repository that are authored by you.
+List them in a separate buffer."
+ (interactive (list (oref (forge-get-repository t) id)))
+ (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil
+ (lambda ()
+ (forge-sql [:select $i1 :from [pullreq]
+ :where (and (= pullreq:repository $s2)
+ (= pullreq:author $s3)
+ (isnull pullreq:closed))
+ :order-by [(desc updated)]]
+ (forge--tablist-columns-vector 'pullreq)
+ id (ghub--username (forge-get-repository (list :id id)))))))
+
+;;;###autoload
+(defun forge-list-authored-issues (id)
+ "List open issues from the current repository that are authored by you.
+List them in a separate buffer."
+ (interactive (list (oref (forge-get-repository t) id)))
+ (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil
+ (lambda ()
+ (forge-sql [:select $i1 :from [issue]
+ :where (and (= issue:repository $s2)
+ (= issue:author $s3)
+ (isnull issue:closed))
+ :order-by [(desc updated)]]
+ (forge--tablist-columns-vector 'issue)
+ id (ghub--username (forge-get-repository (list :id id)))))))
+
+;;;; Repository
+
+;;;###autoload
+(defun forge-list-repositories ()
+ "List known repositories in a separate buffer.
+Here \"known\" means that an entry exists in the local database."
+ (interactive)
+ (forge-repository-list-setup #'forge-repository-list-refresh
+ "*Forge Repositories*"))
+
+;;;###autoload
+(defun 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."
+ (interactive)
+ (forge-repository-list-setup #'forge-repository-list-owned-refresh
+ "*Forge Owned Repositories*"))
+
+;;; Internal
+
+(defun forge-topic-list-sort-by-number (a b)
+ "Sort the `tabulated-list-entries' by topic number.
+This assumes that `number' is the first column, otherwise
+it silently fails."
+ (ignore-errors
+ (> (read (aref (cadr a) 0))
+ (read (aref (cadr b) 0)))))
+
+(defun forge--tablist-columns-vector (&optional table)
+ (let ((columns (cons 'id (--map (nth 4 it) forge--tabulated-list-columns))))
+ (vconcat (if table
+ (let ((table (symbol-name table)))
+ (--map (let ((col (symbol-name it)))
+ (if (string-search ":" col)
+ it
+ (intern (concat table ":" col))))
+ columns))
+ columns))))
+
+(defun forge--tablist-format-entry (row)
+ (list (car row)
+ (vconcat
+ (cl-mapcar (lambda (val col)
+ (if-let ((pp (nth 5 col)))
+ (funcall pp val)
+ (if val (format "%s" val) "")))
+ (cdr row)
+ forge--tabulated-list-columns))))
+
+;;; _
+(provide 'forge-list)
+;;; forge-list.el ends here
--- /dev/null
+;;; forge-notify.el --- Notify support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+;; 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)
+
+;;; 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)
+ (forge :initarg :forge)
+ (reason :initarg :reason)
+ (unread-p :initarg :unread-p)
+ (last-read :initarg :last-read)
+ (updated :initarg :updated)
+ (title :initarg :title)
+ (type :initarg :type)
+ (topic :initarg :topic)
+ (url :initarg :url)))
+
+;;; Core
+
+(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-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)))
+
+;;; Utilities
+
+(cl-defmethod forge-get-url ((notify forge-notification))
+ (oref notify url))
+
+;;; Mode
+
+(defvar-keymap forge-notifications-mode-map
+ :doc "Keymap for `forge-notifications-mode'."
+ :parent magit-mode-map)
+
+(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 ()
+ ;; There should only ever be one such buffer.
+ (cl-letf (((symbol-function 'magit-get-mode-buffer)
+ (lambda (&rest _)
+ (get-buffer-create "*forge-notifications*"))))
+ (magit-setup-buffer #'forge-notifications-mode)))
+
+(defun forge-notifications-refresh-buffer ()
+ (forge-insert-notifications))
+
+;;; Utilities
+
+(defun forge--list-notifications-all ()
+ (closql-query (forge-db) nil nil 'forge-notification))
+
+(defun forge--list-notifications-unread ()
+ (mapcar (lambda (row)
+ (closql--remake-instance 'forge-notification (forge-db) row))
+ (forge-sql [:select * :from notification
+ :where (notnull unread-p)
+ :order-by [(desc id)]])))
+
+;;; Sections
+
+;; The double-prefix is necessary due to a limitation of magit-insert-section.
+(defvar-keymap forge-forge-repo-section-map
+ "<remap> <magit-browse-thing>" #'forge-browse-repository
+ "<remap> <magit-visit-thing>" #'forge-visit-repository)
+
+(defun forge-insert-notifications ()
+ (when-let ((ns (forge--list-notifications-all)))
+ (magit-insert-section (notifications)
+ (magit-insert-heading "Notifications:")
+ (pcase-dolist (`(,_ . ,ns) (--group-by (oref it repository) ns))
+ (let ((repo (forge-get-repository (car ns))))
+ (magit-insert-section (forge-repo repo t)
+ (magit-insert-heading
+ (concat (propertize (format "%s/%s"
+ (oref repo owner)
+ (oref repo name))
+ 'font-lock-face 'bold)
+ (format " (%s)" (length ns))))
+ (magit-insert-section-body
+ (dolist (notify ns)
+ (with-slots (type topic title url unread-p) notify
+ (pcase type
+ ('issue
+ (forge-insert-topic (forge-get-issue repo topic)))
+ ('pullreq
+ (forge-insert-topic (forge-get-pullreq repo topic)))
+ ('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 unread-p
+ '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 notify)
+ (insert (propertize (format "(%s) %s\n" type title)
+ 'font-lock-face 'error)))))))
+ (insert ?\n))))))))
+
+;;; _
+(provide 'forge-notify)
+;;; forge-notify.el ends here
--- /dev/null
+(define-package "forge" "20230711.1157" "Access Git forges from Magit."
+ '((emacs "25.1")
+ (compat "29.1.4.1")
+ (closql "20230407")
+ (dash "2.19.1")
+ (emacsql "20230409")
+ (ghub "20220621")
+ (let-alist "1.0.6")
+ (magit "20230319")
+ (markdown-mode "2.4")
+ (transient "0.4.0")
+ (yaml "0.5.2"))
+ :commit "32cbf6646132a982219bd7bca9091a25d4b97963" :authors
+ '(("Jonas Bernoulli" . "jonasNOSPAMbernoul.li"))
+ :maintainer
+ '("Jonas Bernoulli" . "jonasNOSPAMbernoul.li")
+ :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-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+;; 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
+
+(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)))
+
+;;; Utilities
+
+(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-browse :after ((post forge-post))
+ (oset (forge-get-topic post) unread-p nil))
+
+;;; Sections
+
+(defun forge-post-at-point ()
+ (magit-section-value-if '(issue pullreq post)))
+
+(defun forge-comment-at-point ()
+ (and (magit-section-value-if '(post))
+ (let ((post (oref (magit-current-section) value)))
+ (and (or (forge-pullreq-post-p post)
+ (forge-issue-post-p post))
+ post))))
+
+(defun forge-topic-at-point ()
+ (or (magit-section-value-if '(issue pullreq))
+ (and-let* ((branch (magit-branch-at-point))
+ (n (magit-get "branch" branch "pullRequest")))
+ (forge-get-pullreq (string-to-number n)))
+ (and-let* ((rev (magit-commit-at-point)))
+ (forge--pullreq-from-rev rev))
+ (forge--issue-by-forge-short-link-at-point)
+ (forge--pullreq-by-forge-short-link-at-point)))
+
+(defun forge-current-topic ()
+ (or (forge-topic-at-point)
+ (and (derived-mode-p 'forge-topic-mode)
+ forge-buffer-topic)
+ (and (derived-mode-p 'forge-topic-list-mode)
+ (forge-get-topic (tabulated-list-get-id)))))
+
+(defun forge--pullreq-from-rev (rev)
+ (and-let* ((repo (forge-get-repository nil))
+ (refspec (oref repo pullreq-refspec))
+ (name (magit-rev-name rev (cadr (split-string refspec ":")))))
+ (save-match-data
+ (and (string-match "\\([0-9]*\\)\\([~^][0-9]*\\)?\\'" name)
+ (forge-get-pullreq (string-to-number (match-string 0 name)))))))
+
+;;; 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 t)
+ (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)
+ (or (and (fboundp 'forge-pullreq-p)
+ (forge-pullreq-p topic))
+ (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)
+ (when (buffer-live-p prevbuf)
+ (magit-refresh))))
+
+;;; _
+(provide 'forge-post)
+;;; forge-post.el ends here
--- /dev/null
+;;; forge-pullreq.el --- Pullreq support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+;; 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)
+ (closed :initarg :closed)
+ (merged :initarg :merged)
+ (unread-p :initarg :unread-p :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)
+ ))
+
+(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
+
+(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 t)))
+ (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-ls-pullreqs ((repo forge-repository) &optional type select)
+ (forge-ls-topics repo 'forge-pullreq type select))
+
+;;; Utilities
+
+(defun forge-read-pullreq (prompt &optional type)
+ (when (eq type t)
+ (setq type (if current-prefix-arg nil 'open)))
+ (let* ((default (forge-current-pullreq))
+ (repo (forge-get-repository (or default t)))
+ (choices (mapcar
+ (apply-partially #'forge--topic-format-choice repo)
+ (forge-ls-pullreqs repo type [number title id class]))))
+ (cdr (assoc (magit-completing-read
+ prompt choices nil nil nil nil
+ (and default
+ (setq default (forge--topic-format-choice default))
+ (member default choices)
+ (car default)))
+ choices))))
+
+(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)))
+
+(cl-defmethod forge-get-url ((pullreq forge-pullreq))
+ (forge--format pullreq 'pullreq-url-format))
+
+(defun forge--pullreq-by-forge-short-link-at-point ()
+ (forge--topic-by-forge-short-link-at-point '("#" "!") #'forge-get-pullreq))
+
+;;; Sections
+
+(defun forge-current-pullreq ()
+ (or (forge-pullreq-at-point)
+ (and (derived-mode-p 'forge-topic-mode)
+ (forge-pullreq-p forge-buffer-topic)
+ forge-buffer-topic)
+ (and (derived-mode-p 'forge-topic-list-mode)
+ (let ((topic (forge-get-topic (tabulated-list-get-id))))
+ (and (forge-pullreq-p topic)
+ topic)))))
+
+(defun forge-pullreq-at-point ()
+ (or (magit-section-value-if 'pullreq)
+ (and-let* ((post (magit-section-value-if 'post)))
+ (cond ((forge-pullreq-p post)
+ post)
+ ((forge-pullreq-post-p post)
+ (forge-get-pullreq post))))
+ (forge--pullreq-by-forge-short-link-at-point)))
+
+(defvar-keymap forge-pullreqs-section-map
+ "<remap> <magit-browse-thing>" #'forge-browse-pullreqs
+ "<remap> <magit-visit-thing>" #'forge-list-pullreqs
+ "C-c C-n" #'forge-create-pullreq)
+
+(defvar-keymap forge-pullreq-section-map
+ "<remap> <magit-browse-thing>" #'forge-browse-pullreq
+ "<remap> <magit-visit-thing>" #'forge-visit-pullreq)
+
+(defun forge-insert-pullreqs ()
+ "Insert a list of mostly recent and/or open pull-requests.
+Also see option `forge-topic-list-limit'."
+ (when (and forge-display-in-status-buffer (forge-db t))
+ (when-let ((repo (forge-get-repository nil)))
+ (unless (oref repo sparse-p)
+ (forge-insert-topics "Pull requests"
+ (forge-ls-recent-topics repo 'pullreq)
+ (forge--topic-type-prefix repo 'pullreq))))))
+
+(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)))
+ (magit-make-margin-overlay nil t))
+ (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))))))
+
+(cl-defmethod forge--insert-topic-contents :after ((pullreq forge-pullreq)
+ _width _prefix)
+ (unless (oref pullreq merged)
+ (magit-insert-heading)
+ (forge--insert-pullreq-commits pullreq)))
+
+(cl-defmethod forge--format-topic-id ((pullreq forge-pullreq) &optional prefix)
+ (propertize (format "%s%s"
+ (or prefix (forge--topic-type-prefix pullreq))
+ (oref pullreq number))
+ 'font-lock-face (if (oref pullreq merged)
+ 'forge-topic-merged
+ 'forge-topic-unmerged)))
+
+(cl-defmethod forge--topic-type-prefix ((pullreq forge-pullreq))
+ (if (forge--childp (forge-get-repository pullreq) 'forge-gitlab-repository)
+ "!"
+ "#"))
+
+(defun forge-insert-assigned-pullreqs ()
+ "Insert a list of open pull-requests that are assigned to you."
+ (when forge-display-in-status-buffer
+ (when-let ((repo (forge-get-repository nil)))
+ (unless (oref repo sparse-p)
+ (forge-insert-topics "Assigned pull requests"
+ (forge--ls-assigned-pullreqs repo)
+ (forge--topic-type-prefix repo 'pullreq))))))
+
+(defun forge--ls-assigned-pullreqs (repo)
+ (mapcar (lambda (row)
+ (closql--remake-instance 'forge-pullreq (forge-db) row))
+ (forge-sql
+ [:select $i1 :from pullreq
+ :join pullreq_assignee :on (= pullreq_assignee:pullreq pullreq:id)
+ :join assignee :on (= pullreq_assignee:id assignee:id)
+ :where (and (= pullreq:repository $s2)
+ (= assignee:login $s3)
+ (isnull pullreq:closed))
+ :order-by [(desc updated)]]
+ (vconcat (closql--table-columns (forge-db) 'pullreq t))
+ (oref repo id)
+ (ghub--username repo))))
+
+(defun forge-insert-requested-reviews ()
+ "Insert a list of pull-requests that are awaiting your review."
+ (when-let ((repo (forge-get-repository nil)))
+ (unless (oref repo sparse-p)
+ (forge-insert-topics "Pull requests awaiting review"
+ (forge--ls-requested-reviews repo)
+ (forge--topic-type-prefix repo 'pullreq)))))
+
+(defun forge--ls-requested-reviews (repo)
+ (mapcar
+ (lambda (row)
+ (closql--remake-instance 'forge-pullreq (forge-db) row))
+ (forge-sql
+ [:select $i1 :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 $s2)
+ (= assignee:login $s3)
+ (isnull pullreq:closed))
+ :order-by [(desc updated)]]
+ (vconcat (closql--table-columns (forge-db) 'pullreq t))
+ (oref repo id)
+ (ghub--username repo))))
+
+(defun forge-insert-authored-pullreqs ()
+ "Insert a list of open pullreqs that are authored to you."
+ (when forge-display-in-status-buffer
+ (when-let ((repo (forge-get-repository nil)))
+ (unless (oref repo sparse-p)
+ (forge-insert-topics "Authored pullreqs"
+ (forge--ls-authored-pullreqs repo)
+ (forge--topic-type-prefix repo 'pullreq))))))
+
+(defun forge--ls-authored-pullreqs (repo)
+ (mapcar (lambda (row)
+ (closql--remake-instance 'forge-pullreq (forge-db) row))
+ (forge-sql
+ [:select $i1 :from [pullreq]
+ :where (and (= pullreq:repository $s2)
+ (= pullreq:author $s3)
+ (isnull pullreq:closed))
+ :order-by [(desc updated)]]
+ (vconcat (closql--table-columns (forge-db) 'pullreq t))
+ (oref repo id)
+ (ghub--username repo))))
+
+;;; _
+(provide 'forge-pullreq)
+;;; forge-pullreq.el ends here
--- /dev/null
+;;; forge-repo.el --- Repository support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+;; 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)
+ (sparse-p :initform t)
+ (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))
+ :abstract t)
+
+(defclass forge-unusedapi-repository (forge-repository) () :abstract t)
+
+(defclass forge-noapi-repository (forge-repository) () :abstract t)
+
+;;; Core
+
+(cl-defmethod forge--repository-ids ((class (subclass forge-repository))
+ host owner name &optional stub)
+ "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)
+ (or (assoc host forge-alist)
+ (error "No entry for %S in forge-alist" host)))
+ (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)))))
+ (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)
+ (let ((their-id (if owner (concat owner "/" name) name)))
+ (cons (base64-encode-string
+ (format "%s:%s"
+ (nth 3 (or (assoc host forge-alist)
+ (error "No entry for %S in forge-alist" host)))
+ their-id)
+ t)
+ their-id)))
+
+(defvar-local forge-buffer-repository nil)
+(put 'forge-buffer-repository 'permanent-local t)
+
+(defconst forge--signal-no-entry '(t stub create))
+
+(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 (((_ id) (head :id)))
+ (closql-get (forge-db) id 'forge-repository))
+
+(cl-defmethod forge-get-repository ((demand symbol) &optional remote)
+ "Return the current forge repository.
+
+If the `forge-buffer-repository' is non-nil, then return that.
+Otherwise if `forge-buffer-topic' is non-nil, then return the
+repository for that. Finally if both variables are nil, then
+return the forge repository corresponding to the current Git
+repository, if any."
+ (or forge-buffer-repository
+ (and forge-buffer-topic
+ (forge-get-repository forge-buffer-topic))
+ (magit--with-refresh-cache
+ (list default-directory 'forge-get-repository demand)
+ (unless remote
+ (setq remote (forge--get-remote 'warn)))
+ (if-let ((url (and remote
+ (magit-git-string "remote" "get-url" remote))))
+ (when-let* ((repo (forge-get-repository url remote demand)))
+ ;; Cannot use and-let* because of 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-url url)))
+ (forge-get-repository parts remote demand)
+ (when (memq demand forge--signal-no-entry)
+ (error "Cannot determine forge repository. %s isn't a forge url" url))))
+
+(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."
+ (if-let ((spec (assoc host forge-alist)))
+ (pcase-let ((`(,githost ,apihost ,forge ,class) spec))
+ (let* ((row (car (forge-sql [:select * :from repository
+ :where (and (= forge $s1)
+ (= owner $s2)
+ (= name $s3))]
+ forge owner name)))
+ (obj (and row (closql--remake-instance class (forge-db) row))))
+ (when obj
+ (oset obj apihost apihost)
+ (oset obj githost githost)
+ (oset obj remote remote))
+ (cond ((and (eq demand t)
+ (or (not obj)
+ (oref obj sparse-p)))
+ (error "Cannot use `%s' in %S yet.\n%s"
+ this-command (magit-toplevel)
+ "Use `M-x forge-add-repository' before trying again."))
+ ((and (eq demand 'full) obj
+ (oref obj sparse-p))
+ (setq obj nil)))
+ (when (and (memq demand '(stub create))
+ (not obj))
+ (pcase-let ((`(,id . ,forge-id)
+ (forge--repository-ids class host owner name
+ (eq demand 'stub))))
+ ;; The repo might have been renamed on the forge. #188
+ (unless (setq obj (forge-get-repository (list :id id)))
+ (setq obj (funcall class
+ :id id
+ :forge-id forge-id
+ :forge forge
+ :owner owner
+ :name name
+ :apihost apihost
+ :githost githost
+ :remote remote))
+ (when (eq demand 'create)
+ (closql-insert (forge-db) obj)))))
+ 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))
+ repo)
+
+;;; Utilities
+
+(defun forge-repository-at-point ()
+ (magit-section-value-if 'forge-repo))
+
+(defun forge-current-repository ()
+ (or (forge-repository-at-point)
+ (and (derived-mode-p 'forge-repository-list-mode)
+ (forge-get-repository (list :id (tabulated-list-get-id))))))
+
+(cl-defmethod forge-visit ((repo forge-repository))
+ (let ((worktree (oref repo worktree)))
+ (if (and worktree (file-directory-p worktree))
+ (magit-status-setup-buffer worktree)
+ (forge-list-issues (oref repo id)))))
+
+(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 (or (forge-current-repository)
+ (forge-get-repository nil))))
+ (format "%s/%s @%s"
+ (oref default owner)
+ (oref default name)
+ (oref default githost))))))
+ (save-match-data
+ (if (string-match "\\`\\(.+\\)/\\([^/]+\\) @\\(.+\\)\\'" choice)
+ (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
+ (-keep (pcase-lambda (`(,githost ,_apihost ,_id ,c))
+ (and (child-of-class-p c class) githost))
+ forge-alist)
+ (mapcar #'car forge-alist))
+ nil t))
+
+(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 githost for %S" host)))
+
+(cl-defmethod forge--topics-until ((repo forge-repository) until table)
+ (if (oref repo sparse-p)
+ until
+ (caar (forge-sql [:select [updated] :from $i1
+ :where (= repository $s2)
+ :order-by [(desc updated)]
+ :limit 1]
+ table (oref repo id)))))
+
+(cl-defmethod forge--format ((repo forge-repository) format-or-slot &optional spec)
+ (format-spec
+ (if (symbolp format-or-slot)
+ (eieio-oref repo format-or-slot)
+ format-or-slot)
+ (with-slots (githost owner name) repo
+ (let ((path (if owner (concat owner "/" name) name)))
+ `(,@spec
+ (?h . ,githost)
+ (?o . ,owner)
+ (?n . ,name)
+ (?p . ,path)
+ (?P . ,(string-replace "/" "%2F" path)))))))
+
+(cl-defmethod forge-get-url ((repo forge-repository))
+ (forge--format (oref repo remote) 'remote-url-format))
+
+(defun forge--set-field-callback ()
+ (let ((buf (current-buffer)))
+ (lambda (&rest _)
+ (with-current-buffer
+ (or buf (current-buffer))
+ (forge-pull)))))
+
+(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 ((sym (forge--ghub-type-symbol (eieio-object-class repo))))
+ (cl-call-next-method (ghub--host sym) sym)))
+
+(defun forge--ghub-type-symbol (class)
+ (cl-ecase class
+ ;; This package does not define a `forge-gitlab-http-repository'
+ ;; class, but we suggest at #9 that users define such a class if
+ ;; they must connect to a Gitlab instance that uses http instead
+ ;; of https.
+ ((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-revnote.el --- Revnote support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+;; 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-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+;; 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)
+
+(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-topic.el --- Topics support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+;; 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 issues")
+ (cons (number :tag "Maximal number of open issues")
+ (number :tag "Maximal number of closed issues"))))
+
+(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
+
+(defface forge-topic-unread
+ '((t :inherit bold))
+ "Face used for title of unread topics."
+ :group 'forge-faces)
+
+(defface forge-topic-closed
+ '((t :inherit magit-dimmed))
+ "Face used for title of closed topics."
+ :group 'forge-faces)
+
+(defface forge-topic-open
+ '((t :inherit default))
+ "Face used for title of open topics."
+ :group 'forge-faces)
+
+(defface forge-topic-merged
+ '((t :inherit magit-dimmed))
+ "Face used for number of merged pull-requests."
+ :group 'forge-faces)
+
+(defface forge-topic-unmerged
+ '((t :inherit magit-dimmed :slant italic))
+ "Face used for number of unmerged pull-requests."
+ :group 'forge-faces)
+
+(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)
+
+(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 encode. 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))
+
+;;; Query
+
+(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)))
+
+(cl-defmethod forge-ls-recent-topics ((repo forge-repository) table)
+ (magit--with-repository-local-cache (list 'forge-ls-recent-topics 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)
+ (notnull unread-p))]
+ 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)))))))
+
+(cl-defmethod forge-ls-topics ((repo forge-repository)
+ class &optional type select)
+ (let* ((table (oref-default class closql-table))
+ (id (oref repo id))
+ (rows (pcase-exhaustive type
+ (`open (forge-sql [:select $i1 :from $i2
+ :where (and (= repository $s3)
+ (isnull closed))
+ :order-by [(desc number)]]
+ (or select '*) table id))
+ (`closed (forge-sql [:select $i1 :from $i2
+ :where (and (= repository $s3)
+ (notnull closed))
+ :order-by [(desc number)]]
+ (or select '*) table id))
+ (`nil (forge-sql [:select $i1 :from $i2
+ :where (= repository $s3)
+ :order-by [(desc number)]]
+ (or select '*) table id)))))
+ (if select
+ rows
+ (mapcar (lambda (row)
+ (closql--remake-instance class (forge-db) row))
+ rows))))
+
+;;; Utilities
+
+(cl-defmethod forge--format ((topic forge-topic) slot &optional spec)
+ (forge--format (forge-get-repository topic) slot
+ `(,@spec (?i . ,(oref topic number)))))
+
+(cl-defmethod forge-visit ((topic forge-topic))
+ (forge-topic-setup-buffer topic)
+ (forge-topic-mark-read (forge-get-repository topic) topic))
+
+(cl-defmethod forge-topic-mark-read ((_ forge-repository) topic)
+ (oset topic unread-p nil))
+
+(defun forge--sanitize-string (string)
+ ;; For Gitlab this may also be nil.
+ (if string (string-replace "\r\n" "\n" string) ""))
+
+(defun forge-insert-topics (heading topics prefix)
+ "Under a new section with HEADING, insert TOPICS."
+ (when topics
+ (let ((width (apply #'max
+ (--map (length (number-to-string (oref it number)))
+ topics)))
+ list-section-type topic-section-type)
+ (cond ((forge--childp (car topics) 'forge-issue)
+ (setq list-section-type 'issues)
+ (setq topic-section-type 'issue))
+ ((forge--childp (car topics) 'forge-pullreq)
+ (setq list-section-type 'pullreqs)
+ (setq topic-section-type 'pullreq)))
+ (magit-insert-section ((eval list-section-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-make-margin-overlay nil t)
+ (magit-insert-section-body
+ (dolist (topic topics)
+ (forge-insert-topic topic topic-section-type width prefix))
+ (insert ?\n)
+ (magit-make-margin-overlay nil t))))))
+
+(defun forge-insert-topic (topic &optional topic-section-type width prefix)
+ "Insert TOPIC as a new section.
+If TOPIC-SECTION-TYPE is provided, it is the section type to use.
+If WIDTH is provided, it is a fixed width to use for the topic
+identifier."
+ (unless topic-section-type
+ (setq topic-section-type
+ (cond ((forge--childp topic 'forge-issue) 'issue)
+ ((forge--childp topic 'forge-pullreq) 'pullreq))))
+ (magit-insert-section ((eval topic-section-type) topic t)
+ (forge--insert-topic-contents topic width prefix)))
+
+(cl-defmethod forge--format-topic-id ((topic forge-topic) &optional prefix)
+ (propertize (format "%s%s"
+ (or prefix (forge--topic-type-prefix topic))
+ (oref topic number))
+ 'font-lock-face 'magit-dimmed))
+
+(cl-defmethod forge--insert-topic-contents ((topic forge-topic) width prefix)
+ (with-slots (number title unread-p closed) topic
+ (insert (format (if width (format "%%-%is" (1+ width)) "%s")
+ (forge--format-topic-id topic prefix)))
+ (forge--insert-topic-marks topic)
+ (insert " ")
+ (insert (magit-log-propertize-keywords
+ nil (propertize title 'font-lock-face
+ (cond (unread-p 'forge-topic-unread)
+ (closed 'forge-topic-closed)
+ (t 'forge-topic-open)))))
+ (forge--insert-topic-labels topic)
+ (insert "\n")
+ (magit-log-format-author-margin
+ (oref topic author)
+ (format-time-string "%s" (parse-iso8601-time-string (oref topic created)))
+ t)))
+
+(defun forge--topic-by-forge-short-link-at-point (known-prefixes finder)
+ "Finds a topic by forge-dependant short link around point.
+The topic number is expected to be a number prefixed by any of
+the elements in KNOWN-PREFIXES. If a reference is found, FINDER
+is called and a topic object is returned if available."
+ (and-let* ((number (number-at-point))
+ (prefix (buffer-substring-no-properties
+ (- (match-beginning 0) 1)
+ (match-beginning 0))))
+ (and (member prefix known-prefixes)
+ (funcall finder number))))
+
+;;; Mode
+
+(defvar-keymap forge-topic-mode-map
+ "C-c C-n" #'forge-create-post
+ "C-c C-r" #'forge-create-post
+ "<remap> <magit-browse-thing>" #'forge-browse-topic
+ "<remap> <magit-visit-thing>" #'markdown-follow-link-at-point
+ "<mouse-2>" #'markdown-follow-link-at-point)
+
+(define-derived-mode forge-topic-mode magit-mode "View Topic"
+ "View a forge issue or pull-request."
+ (setq-local markdown-translate-filename-function
+ #'forge--markdown-translate-filename-function))
+
+(defvar forge-topic-headers-hook
+ '(forge-insert-topic-title
+ forge-insert-topic-state
+ forge-insert-topic-draft
+ 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-keymap forge-post-section-map
+ "<remap> <magit-browse-thing>" #'forge-browse-post
+ "<remap> <magit-edit-thing>" #'forge-edit-post
+ "C-c C-k" #'forge-delete-comment)
+
+(defvar-local forge-buffer-topic nil)
+(defvar-local forge-buffer-topic-ident nil)
+
+(defun forge-topic-setup-buffer (topic)
+ (let* ((repo (forge-get-repository topic))
+ (ident (concat (forge--topic-type-prefix topic)
+ (number-to-string (oref topic number))))
+ (name (format "*forge: %s/%s %s*"
+ (oref repo owner)
+ (oref repo name)
+ ident))
+ (magit-generate-buffer-name-function (lambda (_mode _value) name))
+ (current-repo (forge-get-repository nil))
+ (default-directory (if (and current-repo
+ (eq (oref current-repo id)
+ (oref repo id)))
+ default-directory
+ (or (oref repo worktree)
+ default-directory))))
+ (magit-setup-buffer #'forge-topic-mode t
+ (forge-buffer-topic topic)
+ (forge-buffer-topic-ident ident))))
+
+(defun forge-topic-refresh-buffer ()
+ (let ((topic (closql-reload forge-buffer-topic)))
+ (setq forge-buffer-topic topic)
+ (magit-set-header-line-format
+ (format "%s: %s" forge-buffer-topic-ident (oref topic title)))
+ (magit-insert-section (topicbuf)
+ (magit-insert-headers 'forge-topic-headers-hook)
+ (when (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))
+ forge-buffer-topic-ident)
+
+(defvar-keymap forge-topic-title-section-map
+ "<remap> <magit-edit-thing>" #'forge-edit-topic-title)
+
+(cl-defun forge-insert-topic-title
+ (&optional (topic forge-buffer-topic))
+ (magit-insert-section (topic-title)
+ (insert (format "%-11s" "Title: ") (oref topic title) "\n")))
+
+(defvar-keymap forge-topic-state-section-map
+ "<remap> <magit-edit-thing>" #'forge-edit-topic-state)
+
+(cl-defun forge-insert-topic-state
+ (&optional (topic forge-buffer-topic))
+ (magit-insert-section (topic-state)
+ (insert (format
+ "%-11s%s\n" "State: "
+ (let ((state (oref topic state)))
+ (magit--propertize-face
+ (symbol-name state)
+ (pcase (list state (forge-pullreq-p (forge-topic-at-point)))
+ ('(merged) 'forge-topic-merged)
+ ('(closed) 'forge-topic-closed)
+ ('(open t) 'forge-topic-unmerged)
+ ('(open) 'forge-topic-open))))))))
+
+(defvar-keymap forge-topic-draft-section-map
+ "<remap> <magit-edit-thing>" #'forge-edit-topic-draft)
+
+(cl-defun forge-insert-topic-draft
+ (&optional (topic forge-buffer-topic))
+ (when (forge-pullreq-p topic)
+ (magit-insert-section (topic-draft)
+ (insert (format "%-11s%s\n" "Draft: " (oref topic draft-p))))))
+
+(defvar-keymap forge-topic-milestone-section-map
+ "<remap> <magit-edit-thing>" #'forge-edit-topic-milestone)
+
+(cl-defun forge-insert-topic-milestone
+ (&optional (topic forge-buffer-topic))
+ (magit-insert-section (topic-milestone)
+ (insert (format "%-11s" "Milestone: ")
+ (or (forge--get-topic-milestone topic)
+ ;; If the user hasn't pulled this repository yet after
+ ;; updating to db v7, then only the id is available.
+ (oref topic milestone)
+ (propertize "none" 'font-lock-face 'magit-dimmed))
+ "\n")))
+
+(defun forge--get-topic-milestone (topic)
+ (and-let* ((id (oref topic milestone)))
+ (caar (forge-sql [:select [title] :from milestone :where (= id $s1)] id))))
+
+(defvar-keymap forge-topic-labels-section-map
+ "<remap> <magit-edit-thing>" #'forge-edit-topic-labels)
+
+(cl-defun forge-insert-topic-labels
+ (&optional (topic forge-buffer-topic))
+ (magit-insert-section (topic-labels)
+ (insert (format "%-11s" "Labels: "))
+ (if-let ((labels (closql--iref topic 'labels)))
+ (forge--insert-topic-labels topic t labels)
+ (insert (propertize "none" 'font-lock-face 'magit-dimmed)))
+ (insert ?\n)))
+
+(defun forge--format-topic-labels (topic)
+ (and-let* ((labels (closql--iref topic 'labels)))
+ (mapconcat (pcase-lambda (`(,name ,color ,_desc))
+ (propertize name 'font-lock-face (list :box color)))
+ labels " ")))
+
+(defun forge--insert-topic-labels (topic &optional skip-separator labels)
+ (pcase-dolist (`(,name ,color ,description)
+ (or labels (closql--iref topic 'labels)))
+ (if skip-separator
+ (setq skip-separator nil)
+ (insert " "))
+ (let* ((background (forge--sanitize-color color))
+ (foreground (forge--contrast-color background)))
+ (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))))))
+
+(defvar-keymap forge-topic-marks-section-map
+ "<remap> <magit-edit-thing>" #'forge-edit-topic-marks)
+
+(cl-defun forge-insert-topic-marks
+ (&optional (topic forge-buffer-topic))
+ (magit-insert-section (topic-marks)
+ (insert (format "%-11s" "Marks: "))
+ (if-let ((marks (closql--iref topic 'marks)))
+ (forge--insert-topic-marks topic t marks)
+ (insert (propertize "none" 'font-lock-face 'magit-dimmed)))
+ (insert ?\n)))
+
+(defun forge--insert-topic-marks (topic &optional skip-separator marks)
+ (pcase-dolist (`(,name ,face ,description)
+ (or marks (closql--iref topic 'marks)))
+ (if skip-separator
+ (setq skip-separator nil)
+ (insert " "))
+ (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--sanitize-color (color)
+ (cond ((x-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 (x-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))
+
+(cl-defun forge-insert-topic-refs
+ (&optional (topic forge-buffer-topic))
+ (when (forge-pullreq-p topic)
+ (magit-insert-section (topic-refs)
+ (with-slots (cross-repo-p base-repo base-ref head-repo head-ref) topic
+ (let ((separator (propertize ":" 'font-lock-face 'magit-dimmed))
+ (deleted (propertize "(deleted)" 'font-lock-face 'magit-dimmed)))
+ (insert (format "%-11s" "Refs: ")
+ (if cross-repo-p
+ (concat base-repo separator base-ref)
+ base-ref)
+ (propertize "..." 'font-lock-face 'magit-dimmed)
+ (if cross-repo-p
+ (if (and head-repo head-ref)
+ (concat head-repo separator head-ref)
+ deleted)
+ (or head-ref deleted))
+ "\n"))))))
+
+(defvar-keymap forge-topic-assignees-section-map
+ "<remap> <magit-edit-thing>" #'forge-edit-topic-assignees)
+
+(cl-defun forge-insert-topic-assignees
+ (&optional (topic forge-buffer-topic))
+ (magit-insert-section (topic-assignees)
+ (insert (format "%-11s" "Assignees: "))
+ (if-let ((assignees (closql--iref topic 'assignees)))
+ (insert (mapconcat (pcase-lambda (`(,login ,name))
+ (format "%s%s (@%s)"
+ (forge--format-avatar login)
+ name login))
+ assignees ", "))
+ (insert (propertize "none" 'font-lock-face 'magit-dimmed)))
+ (insert ?\n)))
+
+(defvar-keymap forge-topic-review-requests-section-map
+ "<remap> <magit-edit-thing>" #'forge-edit-topic-review-requests)
+
+(cl-defun forge-insert-topic-review-requests
+ (&optional (topic forge-buffer-topic))
+ (when (forge-pullreq-p topic)
+ (magit-insert-section (topic-review-requests)
+ (insert (format "%-11s" "Review-Requests: "))
+ (if-let ((review-requests (closql--iref topic 'review-requests)))
+ (insert (mapconcat (pcase-lambda (`(,login ,name))
+ (format "%s%s (@%s)"
+ (forge--format-avatar login)
+ name login))
+ review-requests ", "))
+ (insert (propertize "none" 'font-lock-face 'magit-dimmed)))
+ (insert ?\n))))
+
+(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)))
+
+(cl-defmethod forge--topic-type-prefix ((_ forge-topic))
+ "Get the identifier prefix specific to the type of TOPIC."
+ "#")
+
+(cl-defmethod forge--topic-type-prefix ((_repo forge-repository) _type)
+ "#")
+
+(defun forge--markdown-translate-filename-function (file)
+ (if (string-match-p "\\`https?://" file)
+ file
+ (let ((host (oref (forge-get-repository t) githost)))
+ (concat (if (member host ghub-insecure-hosts) "http://" "https://")
+ host
+ (and (not (string-prefix-p "/" file)) "/")
+ file))))
+
+(defun forge--format-avatar (author)
+ (if forge-format-avatar-function
+ (funcall forge-format-avatar-function author)
+ ""))
+
+;;; Completion
+
+(defun forge-read-topic (prompt &optional type allow-number)
+ (when (eq type t)
+ (setq type (if current-prefix-arg nil 'open)))
+ (let* ((default (forge-current-topic))
+ (repo (forge-get-repository (or default t)))
+ (choices (mapcar
+ (apply-partially #'forge--topic-format-choice repo)
+ (cl-sort
+ (nconc
+ (forge-ls-pullreqs repo type [number title id class])
+ (forge-ls-issues repo type [number title id class]))
+ #'> :key #'car)))
+ (choice (magit-completing-read
+ prompt choices nil nil nil nil
+ (and default
+ (setq default (forge--topic-format-choice default))
+ (member default choices)
+ (car default)))))
+ (or (cdr (assoc choice choices))
+ (and allow-number
+ (let ((number (string-to-number choice)))
+ (if (= number 0)
+ (user-error "Not an existing topic or number: %s")
+ number))))))
+
+(cl-defmethod forge--topic-format-choice ((topic forge-topic))
+ (cons (format "%s%s %s"
+ (forge--topic-type-prefix topic)
+ (oref topic number)
+ (oref topic title))
+ (oref topic id)))
+
+(cl-defmethod forge--topic-format-choice ((repo forge-repository) args)
+ (pcase-let ((`(,number ,title ,id ,class) args))
+ (cons (format "%s%s %s"
+ (forge--topic-type-prefix repo class)
+ number
+ title)
+ id)))
+
+(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 t))
+ (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))))))
+
+;;; Parse
+
+(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)))
+
+;;; Templates
+
+(cl-defgeneric forge--topic-templates (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-templates 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)))
+ (magit--with-safe-default-directory nil
+ (when-let ((repo (forge-get-repository 'full)))
+ (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.el --- Access Git forges from Magit -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; 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-list)
+
+;;; 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.")
+
+(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.
+
+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.")
+
+;;;###autoload
+(with-eval-after-load 'git-commit
+ (when forge-add-default-bindings
+ (define-key git-commit-mode-map (kbd "C-c C-v") #'forge-visit-topic)))
+
+;;;###autoload
+(with-eval-after-load 'magit-mode
+ (when forge-add-default-bindings
+ (define-key magit-mode-map "'" #'forge-dispatch)
+ (define-key magit-mode-map "N" #'forge-dispatch)))
+
+(when forge-add-default-bindings
+ (define-key magit-commit-section-map [remap magit-browse-thing] #'forge-browse-dwim)
+ (define-key magit-remote-section-map [remap magit-browse-thing] #'forge-browse-remote)
+ (define-key magit-branch-section-map [remap magit-browse-thing] #'forge-browse-branch)
+
+ (define-key magit-commit-section-map (kbd "C-c C-v") #'forge-visit-topic)
+ (define-key magit-branch-section-map (kbd "C-c C-v") #'forge-visit-topic)
+
+ (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)
+ (not (equal (getenv "TRAVIS") "true")))
+ (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-2023 Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+ 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-2023 Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+ 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’.
+
+ 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’.
+
+\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 N’ (‘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 n’ (‘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 Options: 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 two 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 three 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 N: Branching. (line 13)
+* b n: 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 73)
+* N l n: Listing Topics and Notifications.
+ (line 65)
+* N l p: Listing Topics and Notifications.
+ (line 69)
+* N l r: Listing Topics and Notifications.
+ (line 62)
+* 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 50)
+* forge-insert-assigned-pullreqs: Listing Topics and Notifications.
+ (line 38)
+* forge-insert-authored-issues: Listing Topics and Notifications.
+ (line 54)
+* forge-insert-authored-pullreqs: Listing Topics and Notifications.
+ (line 46)
+* forge-insert-issues: Listing Topics and Notifications.
+ (line 17)
+* forge-insert-pullreqs: Listing Topics and Notifications.
+ (line 13)
+* forge-insert-requested-reviews: Listing Topics and Notifications.
+ (line 42)
+* forge-list-assigned-issues: Listing Topics and Notifications.
+ (line 88)
+* forge-list-assigned-pullreqs: Listing Topics and Notifications.
+ (line 84)
+* forge-list-authored-issues: Listing Topics and Notifications.
+ (line 100)
+* forge-list-authored-pullreqs: Listing Topics and Notifications.
+ (line 96)
+* forge-list-issues: Listing Topics and Notifications.
+ (line 73)
+* forge-list-labeled-issues: Listing Topics and Notifications.
+ (line 80)
+* forge-list-labeled-pullreqs: Listing Topics and Notifications.
+ (line 76)
+* forge-list-notifications: Listing Topics and Notifications.
+ (line 65)
+* forge-list-owned-issues: Listing Topics and Notifications.
+ (line 110)
+* forge-list-owned-pullreqs: Listing Topics and Notifications.
+ (line 104)
+* forge-list-pullreqs: Listing Topics and Notifications.
+ (line 69)
+* forge-list-repositories: Listing Topics and Notifications.
+ (line 62)
+* forge-list-requested-reviews: Listing Topics and Notifications.
+ (line 92)
+* 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 31)
+* 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-owned-accounts: Listing Topics and Notifications.
+ (line 116)
+* forge-owned-ignored: Listing Topics and Notifications.
+ (line 131)
+* forge-topic-list-limit: Listing Topics and Notifications.
+ (line 20)
+* forge.remote: Repository Detection.
+ (line 66)
+
+
+\1f
+Tag Table:
+Node: Top\7f751
+Node: Introduction\7f2435
+Node: Supported Forges and Hosts\7f2998
+Node: Supported Forges\7f4248
+Ref: Github\7f4404
+Ref: Github Caveats\7f4547
+Ref: Github Hosts\7f5193
+Ref: Gitlab\7f5249
+Ref: Gitlab Caveats\7f5264
+Ref: Gitlab Hosts\7f5389
+Node: Partially Supported Forges\7f5509
+Ref: Gitea https//giteaio\7f5715
+Ref: Gitea Hosts\7f5815
+Ref: Gogs https//gogsio\7f5871
+Ref: Gogs Hosts\7f6074
+Ref: Bitbucket https//bitbucketorg\7f6132
+Ref: Bitbucket Caveats\7f6330
+Ref: Bitbucket Hosts\7f7227
+Node: Supported Semi-Forges\7f7292
+Ref: Gitweb https//git-scmcom/docs/gitweb\7f7463
+Ref: Gitweb Caveats\7f7542
+Ref: Cgit https//gitzx2c4com/cgit/about\7f7782
+Ref: Cgit Caveats\7f7859
+Ref: Cgit Hosts\7f8208
+Ref: Stgit https//codemadnessorg/git/stagit/file/READMEhtml\7f8335
+Ref: Stgit Caveats\7f8452
+Ref: Stgit Hosts\7f8738
+Ref: Srht https//metasrht\7f8798
+Ref: Srht Caveats\7f8847
+Ref: Srht Hosts\7f9130
+Node: Getting Started\7f9181
+Node: Loading Forge\7f10179
+Node: Token Creation\7f10574
+Node: Initial Pull\7f11853
+Node: Repository Detection\7f13248
+Node: Caveats\7f17387
+Node: Usage\7f18313
+Node: Pulling\7f19785
+Node: Branching\7f22468
+Node: Working with Topics\7f28857
+Node: Visiting Topics\7f29230
+Node: Listing Topics and Notifications\7f31307
+Node: Creating Topics\7f36631
+Node: Editing Topics and Posts\7f37120
+Node: Miscellaneous\7f41647
+Node: FAQ\7f44270
+Node: Is it possible to create a single pull-request without pulling everything?\7f44738
+Node: error in process filter HTTP Error 502 "Bad gateway"\7f45204
+Node: Keystroke Index\7f47575
+Node: Function and Command Index\7f53265
+Node: Variable Index\7f61223
+\1f
+End Tag Table
+
+\1f
+Local Variables:
+coding: utf-8
+End:
projects / emacsconfig.git / commitdiff