[2023-01-17 Tue 09:33]
#+begin_src emacs-lisp
- (add-to-list 'load-path "~/.emacs.d/elpa/forge-20241218.2036")
+ (add-to-list 'load-path "~/.emacs.d/elpa/forge-20241223.1032")
(with-eval-after-load 'magit
(require 'forge))
+++ /dev/null
-This is the file .../info/dir, which contains the
-topmost node of the Info hierarchy, called (dir)Top.
-The first time you invoke Info you start off looking at this node.
-\1f
-File: dir, Node: Top This is the top of the INFO tree
-
- This (the Directory node) gives a menu of major topics.
- Typing "q" exits, "H" lists all Info commands, "d" returns here,
- "h" gives a primer for first-timers,
- "mEmacs<Return>" visits the Emacs manual, etc.
-
- In Emacs, you can click mouse button 2 on a menu item or cross reference
- to select it.
-
-* Menu:
-
-Emacs
-* Forge: (forge). Access Git Forges from Magit.
+++ /dev/null
-;;; forge-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
-;; Generated by the `loaddefs-generate' function.
-
-;; This file is part of GNU Emacs.
-
-;;; Code:
-
-(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
-
-
-\f
-;;; Generated autoloads from forge.el
-
-(defvar forge-add-default-bindings t "\
-Whether to add Forge's bindings to various Magit keymaps.
-
-If you want to disable this, then you must set this to nil before
-`magit' is loaded. If you do it before `forge' but after `magit'
-is loaded, then `magit-mode-map' ends up being modified anyway.")
-(with-eval-after-load 'magit-mode (when forge-add-default-bindings (keymap-set magit-mode-map "'" #'forge-dispatch) (keymap-set magit-mode-map "N" #'forge-dispatch) (keymap-set magit-mode-map "<remap> <magit-browse-thing>" #'forge-browse) (keymap-set magit-mode-map "<remap> <magit-copy-thing>" #'forge-copy-url-at-point-as-kill)))
-(with-eval-after-load 'git-commit (when forge-add-default-bindings (keymap-set git-commit-mode-map "C-c C-v" #'forge-visit-topic)))
-(register-definition-prefixes "forge" '("forge-"))
-
-\f
-;;; Generated autoloads from forge-bitbucket.el
-
-(register-definition-prefixes "forge-bitbucket" '("forge-bitbucket-repository"))
-
-\f
-;;; Generated autoloads from forge-commands.el
-
-(autoload 'forge-dispatch "forge-commands" nil t)
-(autoload 'forge-configure "forge-commands" nil t)
-(autoload 'forge-pull "forge-commands" nil t)
-(autoload 'forge-pull-notifications "forge-commands" nil t)
-(autoload 'forge-pull-topic "forge-commands" nil t)
-(autoload 'forge-pull-this-topic "forge-commands" nil t)
-(autoload 'forge-browse-issues "forge-commands" "\
-Visit the current repository's issues using a browser." t)
-(autoload 'forge-browse-pullreqs "forge-commands" "\
-Visit the current repository's pull-requests using a browser." t)
-(autoload 'forge-browse-topic "forge-commands" "\
-Read a TOPIC and visit it using a browser.
-By default only offer open topics but with a prefix argument
-also offer closed topics.
-
-(fn TOPIC)" t)
-(autoload 'forge-browse-issue "forge-commands" "\
-Read an ISSUE and visit it using a browser.
-By default only offer open issues but with a prefix argument
-also offer closed issues.
-
-(fn ISSUE)" t)
-(autoload 'forge-browse-pullreq "forge-commands" "\
-Read a PULL-REQUEST and visit it using a browser.
-By default only offer open pull-requests but with a prefix
-argument also offer closed pull-requests.
-
-(fn PULL-REQUEST)" t)
-(autoload 'forge-browse-commit "forge-commands" "\
-Read a COMMIT and visit it using a browser.
-
-(fn COMMIT)" t)
-(autoload 'forge-browse-branch "forge-commands" "\
-Read a BRANCH and visit it using a browser.
-
-(fn BRANCH)" t)
-(autoload 'forge-browse-remote "forge-commands" "\
-Read a REMOTE and visit it using a browser.
-
-(fn REMOTE)" t)
-(autoload 'forge-browse-repository "forge-commands" "\
-Read a REPOSITORY and visit it using a browser.
-
-(fn REPOSITORY)" t)
-(autoload 'forge-browse-this-topic "forge-commands" nil t)
-(autoload 'forge-browse-this-repository "forge-commands" "\
-Visit the repository at point using a browser." t)
-(autoload 'forge-copy-url-at-point-as-kill "forge-commands" "\
-Copy the url of the thing at point." t)
-(autoload 'forge-browse "forge-commands" "\
-Visit the thing at point using a browser." t)
-(autoload 'forge-visit-topic "forge-commands" "\
-Read a TOPIC and visit it.
-By default only offer active topics for completion. With a prefix
-argument offer all topics. While completion is in progress, \\<forge-read-topic-minibuffer-map>\\[forge-read-topic-lift-limit] lifts
-the limitation to active topics.
-
-(fn TOPIC)" t)
-(autoload 'forge-visit-issue "forge-commands" "\
-Read an ISSUE and visit it.
-By default only offer active issues for completion. With a prefix
-argument offer all topics. While completion is in progress, \\<forge-read-topic-minibuffer-map>\\[forge-read-topic-lift-limit] lifts
-the limitation to active issues.
-
-(fn ISSUE)" t)
-(autoload 'forge-visit-pullreq "forge-commands" "\
-Read a PULL-REQUEST and visit it.
-By default only offer active pull-requests for completion. With a
-prefix argument offer all topics. While completion is in progress,
-\\<forge-read-topic-minibuffer-map>\\[forge-read-topic-lift-limit] lifts the limitation to active pull-requests.
-
-(fn PULL-REQUEST)" t)
-(autoload 'forge-visit-this-topic "forge-commands" "\
-Visit the topic at point.
-With prefix argument MENU, also show the topic menu.
-
-(fn &optional MENU)" t)
-(autoload 'forge-visit-this-repository "forge-commands" "\
-Visit the repository at point." t)
-(autoload 'forge-branch-pullreq "forge-commands" "\
-Create and configure a new branch from a pull-request.
-Please see the manual for more information.
-
-(fn PULLREQ)" t)
-(autoload 'forge-checkout-pullreq "forge-commands" "\
-Create, configure and checkout a new branch from a pull-request.
-Please see the manual for more information.
-
-(fn PULLREQ)" t)
-(autoload 'forge-checkout-this-pullreq "forge-commands" nil t)
-(autoload 'forge-checkout-worktree "forge-commands" "\
-Create, configure and checkout a new worktree from a pull-request.
-This is like `forge-checkout-pullreq', except that it also
-creates a new worktree. Please see the manual for more
-information.
-
-(fn PATH PULLREQ)" t)
-(autoload 'forge-fork "forge-commands" "\
-Fork the current repository to FORK and add it as a REMOTE.
-If the fork already exists, then that isn't an error; the remote
-is added anyway. Currently this only supports Github and Gitlab.
-
-(fn FORK REMOTE)" t)
-(autoload 'forge-merge "forge-commands" nil t)
-(autoload 'forge-rename-default-branch "forge-commands" "\
-Rename the default branch to NEWNAME.
-Change the name on the upstream remotely and locally, and update the
-upstream remotes of local branches accordingly." t)
-(autoload 'forge-add-pullreq-refspec "forge-commands" nil t)
-(autoload 'forge-add-repository "forge-commands" nil t)
-(autoload 'forge-add-user-repositories "forge-commands" "\
-Add all of USER's repositories from HOST to the database.
-This may take a while. Only Github is supported at the moment.
-
-(fn HOST USER)" t)
-(autoload 'forge-add-organization-repositories "forge-commands" "\
-Add all of ORGANIZATION's repositories from HOST to the database.
-This may take a while. Only Github is supported at the moment.
-
-(fn HOST ORGANIZATION)" t)
-(autoload 'forge-remove-repository "forge-commands" "\
-Remove a repository from the database.
-
-(fn REPOSITORY)" t)
-(autoload 'forge-remove-topic-locally "forge-commands" "\
-Remove a topic from the local database only.
-Due to how the supported APIs work, it would be too expensive to
-automatically remove topics from the local database that were
-removed from the forge. The purpose of this command is to allow
-you to manually clean up the local database.
-
-(fn TOPIC)" t)
-(autoload 'forge-reset-database "forge-commands" "\
-Move the current database file to the trash.
-This is useful after the database scheme has changed, which will
-happen a few times while the forge functionality is still under
-heavy development." t)
-(register-definition-prefixes "forge-commands" '("forge-"))
-
-\f
-;;; Generated autoloads from forge-core.el
-
-(register-definition-prefixes "forge-core" '("forge-"))
-
-\f
-;;; Generated autoloads from forge-db.el
-
-(register-definition-prefixes "forge-db" '("forge-"))
-
-\f
-;;; Generated autoloads from forge-gitea.el
-
-(register-definition-prefixes "forge-gitea" '("forge-gitea-repository"))
-
-\f
-;;; Generated autoloads from forge-github.el
-
-(register-definition-prefixes "forge-github" '("forge-"))
-
-\f
-;;; Generated autoloads from forge-gitlab.el
-
-(register-definition-prefixes "forge-gitlab" '("forge-gitlab-repository"))
-
-\f
-;;; Generated autoloads from forge-gogs.el
-
-(register-definition-prefixes "forge-gogs" '("forge-gogs-repository"))
-
-\f
-;;; Generated autoloads from forge-issue.el
-
-(register-definition-prefixes "forge-issue" '("forge-"))
-
-\f
-;;; Generated autoloads from forge-notify.el
-
-(autoload 'forge-list-notifications "forge-notify" nil t)
-(register-definition-prefixes "forge-notify" '("forge-"))
-
-\f
-;;; Generated autoloads from forge-post.el
-
-(register-definition-prefixes "forge-post" '("forge-"))
-
-\f
-;;; Generated autoloads from forge-pullreq.el
-
-(register-definition-prefixes "forge-pullreq" '("forge-"))
-
-\f
-;;; Generated autoloads from forge-repo.el
-
-(register-definition-prefixes "forge-repo" '("forge-"))
-
-\f
-;;; Generated autoloads from forge-repos.el
-
-(autoload 'forge-repositories-menu "forge-repos" nil t)
-(autoload 'forge-list-repositories "forge-repos" nil t)
-(autoload 'forge-list-owned-repositories "forge-repos" nil t)
-(register-definition-prefixes "forge-repos" '("forge-"))
-
-\f
-;;; Generated autoloads from forge-revnote.el
-
-(register-definition-prefixes "forge-revnote" '("forge-revnote"))
-
-\f
-;;; Generated autoloads from forge-semi.el
-
-(register-definition-prefixes "forge-semi" '("forge-"))
-
-\f
-;;; Generated autoloads from forge-tablist.el
-
-(register-definition-prefixes "forge-tablist" '("forge--tab"))
-
-\f
-;;; Generated autoloads from forge-topic.el
-
-(autoload 'forge-topic-menu "forge-topic" nil t)
-(autoload 'forge-topic-state-menu "forge-topic" nil t)
-(autoload 'forge-topic-status-menu "forge-topic" nil t)
-(register-definition-prefixes "forge-topic" '("forge-"))
-
-\f
-;;; Generated autoloads from forge-topics.el
-
-(autoload 'forge-topics-menu "forge-topics" nil t)
-(autoload 'forge-list-topics "forge-topics" nil t)
-(autoload 'forge-list-issues "forge-topics" nil t)
-(autoload 'forge-list-pullreqs "forge-topics" nil t)
-(autoload 'forge-list-global-topics "forge-topics" nil t)
-(autoload 'forge-list-global-issues "forge-topics" nil t)
-(autoload 'forge-list-global-pullreqs "forge-topics" nil t)
-(register-definition-prefixes "forge-topics" '("forge-"))
-\f
-;;; End of scraped data
-
-(provide 'forge-autoloads)
-
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; no-native-compile: t
-;; coding: utf-8-emacs-unix
-;; End:
-
-;;; forge-autoloads.el ends here
+++ /dev/null
-;;; forge-bitbucket.el --- Bitbucket support -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2024 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This file is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this file. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'buck)
-(require 'forge)
-
-;;; Class
-
-(defclass forge-bitbucket-repository (forge-noapi-repository)
- ((issues-url-format :initform "https://%h/%o/%n/issues")
- (issue-url-format :initform "https://%h/%o/%n/issues/%i")
- ;; The anchor for the issue itself is .../%i#issue-%i
- (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#comment-%I")
- (pullreqs-url-format :initform "https://%h/%o/%n/pull-requests")
- (pullreq-url-format :initform "https://%h/%o/%n/pull-requests/%i")
- (pullreq-post-url-format :initform "https://%h/%o/%n/pull-requests/%i#comment-%I")
- (commit-url-format :initform "https://%h/%o/%n/commits/%r")
- (branch-url-format :initform "https://%h/%o/%n/branch/%r")
- (remote-url-format :initform "https://%h/%o/%n/src")
- (create-issue-url-format :initform "https://%h/%o/%n/issues/new")
- (create-pullreq-url-format :initform "https://%h/%o/%n/pull-requests/new")))
-
-;;; _
-(provide 'forge-bitbucket)
-;;; forge-bitbucket.el ends here
+++ /dev/null
-;;; forge-commands.el --- Commands -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2024 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This file is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this file. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'forge)
-
-;;; Options
-
-(defcustom forge-add-pullreq-refspec t
- "Whether the pull-request refspec is added when setting up a repository.
-
-This controls whether running `forge-pull' for the first time in
-a repository also adds a refspec that fetches all pull-requests.
-In repositories with huge numbers of pull-requests you might want
-to not do so, in which case you should set this option to `ask'.
-
-You can also set this to nil and later add the refspec explicitly
-for a repository using the command `forge-add-pullreq-refspec'."
- :package-version '(forge . "0.2.0")
- :group 'forge
- :type '(choice (const :tag "Always add refspec" t)
- (const :tag "Ask every time" ask)
- (const :tag "Never add refspec" nil)))
-
-(defcustom forge-checkout-worktree-read-directory-function
- 'forge-checkout-worktree-default-read-directory-function
- "Function used by `forge-checkout-worktree' to read worktree directory.
-Takes the pull-request as only argument and must return a directory."
- :package-version '(forge . "0.4.0")
- :group 'forge
- :type 'function)
-
-;;; Dispatch
-
-;;;###autoload(autoload 'forge-dispatch "forge-commands" nil t)
-(transient-define-prefix forge-dispatch ()
- "Dispatch a forge command."
- :transient-non-suffix #'transient--do-call
- :refresh-suffixes t
- :environment #'forge--menu-environment
- :column-widths forge--topic-menus-column-widths
- [forge--topic-menus-group
- ["Fetch"
- ("f f" "all topics" forge-pull)
- ("f t" "one topic" forge-pull-topic)
- ("f n" "notifications" forge-pull-notifications)]
- ["Create"
- :if forge--get-repository:tracked?
- ("c i" "issue" forge-create-issue)
- ("c p" "pull-request" forge-create-pullreq)
- ("c u" "pr from issue" forge-create-pullreq-from-issue)
- ("c f" "fork or remote" forge-fork)]
- [:description (lambda ()
- (cond
- ((forge--get-repository:tracked?) "Actions")
- ((or (magit-gitdir) (forge-repository-at-point))
- "Forge does not yet track this repository")
- ("Not inside a Git repository")))
- ("/a" forge-add-repository
- :description (lambda () (let ((repo (forge-get-repository :stub?)))
- (if (or (not repo)
- (eq (oref repo condition) :tracked))
- "track some repo"
- "track this repository"))))
- ("/M" "merge with api" forge-merge
- :if forge--get-repository:tracked? :level 7)]]
- [forge--lists-group
- ["Visit"
- :inapt-if-not forge--get-repository:tracked?
- ("v t" "topic" forge-visit-topic)
- ("v i" "issue" forge-visit-issue)
- ("v p" "pull-request" forge-visit-pullreq)]
- ["Browse"
- ("b t" "topic" forge-browse-topic
- :inapt-if-not forge--get-repository:tracked?)
- ("b i" "issue" forge-browse-issue
- :inapt-if-not forge--get-repository:tracked?)
- ("b p" "pull-request" forge-browse-pullreq
- :inapt-if-not forge--get-repository:tracked?)
- ("b r" "remote" forge-browse-remote)
- ("b I" "issues" forge-browse-issues)
- ("b P" "pull-requests" forge-browse-pullreqs)
- ""]
- ["Display"
- ("-S" forge-toggle-display-in-status-buffer
- :inapt-if-not forge--buffer-with-topics-sections-p)
- ("-H" forge-toggle-topic-legend)]]
- [forge--topic-legend-group])
-
-(transient-augment-suffix forge-dispatch
- :transient #'transient--do-replace
- :inapt-if (lambda () (eq (oref transient--prefix command) 'forge-dispatch))
- :inapt-face 'forge-suffix-active)
-
-;;;###autoload(autoload 'forge-configure "forge-commands" nil t)
-(transient-define-prefix forge-configure ()
- "Configure current repository and global settings."
- :transient-non-suffix #'transient--do-call
- :refresh-suffixes t
- :environment #'forge--menu-environment
- :column-widths forge--topic-menus-column-widths
- [forge--topic-menus-group
- ["Configure"
- ("R " forge-add-pullreq-refspec)
- ("s r" forge-forge.remote)
- ("s l" forge-forge.graphqlItemLimit)]])
-
-(transient-augment-suffix forge-configure
- :transient #'transient--do-replace
- :inapt-if (lambda () (eq (oref transient--prefix command) 'forge-configure))
- :inapt-face 'forge-suffix-active)
-
-;;; Pull
-
-;;;###autoload(autoload 'forge-pull "forge-commands" nil t)
-(transient-define-suffix forge-pull ()
- "Pull forge topics for the current repository if it is already tracked.
-If the current repository is still untracked locally, or the current
-repository cannot be determined, instead invoke `forge-add-repository'."
- :description (lambda ()
- (if (forge-get-repository :tracked?)
- "forge topics"
- "new forge repository"))
- (declare (interactive-only nil))
- (interactive)
- (if-let ((repo (forge-get-repository :tracked?)))
- (forge--pull repo)
- (transient-setup 'forge-add-repository nil nil
- :scope (forge-add-repository--scope))))
-
-(defun forge-read-date (prompt)
- (require (quote org) nil)
- (if (fboundp 'org-read-date)
- (org-read-date nil nil nil prompt)
- (cl-block nil
- (while t
- (let ((str (read-from-minibuffer prompt)))
- (cond ((string-equal str "")
- (cl-return nil))
- ((string-match-p
- "\\`[0-9]\\{4\\}[-/][0-9]\\{2\\}[-/][0-9]\\{2\\}\\'" str)
- (cl-return str))))
- (message "Please enter a date in the format YYYY-MM-DD.")
- (sit-for 1)))))
-
-(cl-defmethod forge--pull ((repo forge-noapi-repository) &rest _)
- (forge--msg repo t t "Pulling from REPO is not supported"))
-
-(cl-defmethod forge--pull ((repo forge-unusedapi-repository) &rest _)
- (magit-git-fetch (oref repo remote) (magit-fetch-arguments)))
-
-(defun forge--maybe-git-fetch (repo &optional buffer)
- (if (buffer-live-p buffer)
- (with-current-buffer buffer
- (if (and (derived-mode-p 'magit-mode)
- (forge-repository-equal (forge-get-repository :stub?) repo)
- (magit-toplevel))
- (magit-git-fetch (oref repo remote) (magit-fetch-arguments))
- (magit-refresh-buffer)))
- (when-let ((worktree (forge-get-worktree repo)))
- (let ((default-directory worktree)
- (magit-inhibit-refresh t))
- (magit-git-fetch (oref repo remote) (magit-fetch-arguments))))))
-
-;;;###autoload(autoload 'forge-pull-notifications "forge-commands" nil t)
-(transient-define-suffix forge-pull-notifications ()
- "Fetch notifications for all repositories from the current forge."
- :description "forge notifications"
- (interactive)
- (if-let ((repo (forge-get-repository :stub?)))
- (let ((class (eieio-object-class repo)))
- (if (eq class 'forge-github-repository)
- (forge--pull-notifications class (oref repo githost))
- (user-error "Fetching notifications not supported for forge %S"
- (oref repo forge))))
- (forge--pull-notifications 'forge-github-repository "github.com")))
-
-;;;###autoload(autoload 'forge-pull-topic "forge-commands" nil t)
-(transient-define-suffix forge-pull-topic (number)
- "Read a topic TYPE and NUMBER pull data about it from its forge."
- :inapt-if-not (lambda () (and (forge--get-repository:tracked?)
- (forge--get-github-repository)))
- (interactive
- (list (read-number "Pull topic: "
- (and-let* ((topic (forge-current-topic)))
- (oref topic number)))))
- (forge--pull-topic (forge-get-repository :tracked) number))
-
-;;;###autoload(autoload 'forge-pull-this-topic "forge-commands" nil t)
-(transient-define-suffix forge-pull-this-topic ()
- "Pull data about the topic at point from its forge."
- :inapt-if-not #'forge--get-github-repository
- :description "fetch"
- (interactive)
- (let ((topic (forge-current-topic t)))
- (forge--pull-topic (forge-get-repository topic) topic)))
-
-(cl-defmethod forge--pull-topic ((repo forge-repository) _topic)
- (error "Fetching an individual topic not implemented for %s"
- (eieio-object-class repo)))
-
-;;; Browse
-
-;;;###autoload
-(defun forge-browse-issues ()
- "Visit the current repository's issues using a browser."
- (interactive)
- (browse-url (forge--format (forge-get-repository :stub)
- 'issues-url-format)))
-
-;;;###autoload
-(defun forge-browse-pullreqs ()
- "Visit the current repository's pull-requests using a browser."
- (interactive)
- (browse-url (forge--format (forge-get-repository :stub)
- 'pullreqs-url-format)))
-
-;;;###autoload
-(defun forge-browse-topic (topic)
- "Read a TOPIC and visit it using a browser.
-By default only offer open topics but with a prefix argument
-also offer closed topics."
- (interactive (list (forge-read-topic "Browse topic")))
- (forge--browse-topic topic))
-
-;;;###autoload
-(defun forge-browse-issue (issue)
- "Read an ISSUE and visit it using a browser.
-By default only offer open issues but with a prefix argument
-also offer closed issues."
- (interactive (list (forge-read-issue "Browse issue")))
- (forge--browse-topic issue))
-
-;;;###autoload
-(defun forge-browse-pullreq (pull-request)
- "Read a PULL-REQUEST and visit it using a browser.
-By default only offer open pull-requests but with a prefix
-argument also offer closed pull-requests."
- (interactive (list (forge-read-pullreq "Browse pull-request")))
- (forge--browse-topic pull-request))
-
-(defun forge--browse-topic (topic)
- (let ((obj (forge-get-topic topic)))
- (browse-url (forge-get-url obj))
- (forge-topic-mark-read obj)))
-
-;;;###autoload
-(defun forge-browse-commit (commit)
- "Read a COMMIT and visit it using a browser."
- (interactive
- (list (or (magit-completing-read "Browse commit"
- (magit-list-branch-names)
- nil nil nil 'magit-revision-history
- (magit-branch-or-commit-at-point))
- (user-error "Nothing selected"))))
- (browse-url (forge-get-url :commit commit)))
-
-;;;###autoload
-(defun forge-browse-branch (branch)
- "Read a BRANCH and visit it using a browser."
- (interactive (list (magit-read-branch "Browse branch")))
- (browse-url (forge-get-url :branch branch)))
-
-;;;###autoload
-(defun forge-browse-remote (remote)
- "Read a REMOTE and visit it using a browser."
- (interactive (list (magit-read-remote "Browse remote" nil t)))
- (browse-url (forge-get-url :remote remote)))
-
-;;;###autoload
-(defun forge-browse-repository (repository)
- "Read a REPOSITORY and visit it using a browser."
- (interactive (list (forge-read-repository "Browse repository")))
- (browse-url (forge-get-url repository)))
-
-;;;###autoload(autoload 'forge-browse-this-topic "forge-commands" nil t)
-(transient-define-suffix forge-browse-this-topic ()
- "Visit the topic at point using a browser."
- :description "browse"
- (interactive)
- (forge-browse-topic (forge-current-topic t)))
-
-;;;###autoload
-(defun forge-browse-this-repository ()
- "Visit the repository at point using a browser."
- (interactive)
- (forge-browse-repository (forge-repository-at-point t)))
-
-;;;###autoload
-(defun forge-copy-url-at-point-as-kill ()
- "Copy the url of the thing at point."
- (interactive)
- (if-let ((target (forge--browse-target)))
- (let ((url (if (stringp target) target (forge-get-url target))))
- (kill-new url)
- (message "Copied \"%s\"" url))
- (user-error "Nothing at point with a URL")))
-
-;;;###autoload
-(defun forge-browse ()
- "Visit the thing at point using a browser."
- (interactive)
- (if-let ((target (forge--browse-target)))
- (if (stringp target)
- (browse-url target)
- (browse-url (forge-get-url target))
- (when (cl-typep target 'forge-topic)
- (forge-topic-mark-read target)))
- (user-error "Nothing to browse here")))
-
-(defun forge--browse-target ()
- (or (and-let* ((branch (magit--painted-branch-at-point)))
- (forge-get-url :branch branch))
- (and-let* ((commit (magit-commit-at-point)))
- (forge-get-url :commit commit))
- (and-let* ((branch (magit-branch-at-point)))
- (forge-get-url :branch branch))
- (and-let* ((remote (magit-remote-at-point)))
- (forge-get-url :remote remote))
- (forge-post-at-point)
- (forge-current-topic)
- (and magit-buffer-revision
- (forge-get-url :commit magit-buffer-revision))
- (forge-get-repository :stub?)))
-
-;;;; Urls
-
-(cl-defgeneric forge-get-url (obj)
- "Return the URL for a forge object.")
-
-(cl-defmethod forge-get-url ((issue forge-issue))
- (forge--format issue 'issue-url-format))
-
-(cl-defmethod forge-get-url ((pullreq forge-pullreq))
- (forge--format pullreq 'pullreq-url-format))
-
-(cl-defmethod forge-get-url ((repo forge-repository))
- (forge--format repo 'remote-url-format))
-
-(cl-defmethod forge-get-url ((_(eql :commit)) commit)
- (let ((repo (forge-get-repository :stub)))
- (unless (magit-list-containing-branches
- commit "-r" (concat (oref repo remote) "/*"))
- (if-let* ((branch (car (magit-list-containing-branches commit "-r")))
- (remote (car (magit-split-branch-name branch))))
- (setq repo (forge-get-repository :stub remote))
- (message "%s does not appear to be available on any remote. %s"
- commit "You might have to push it first.")))
- (forge--format repo 'commit-url-format
- `((?r . ,(magit-commit-p commit))))))
-
-(cl-defmethod forge-get-url ((_(eql :branch)) branch)
- (let (remote)
- (if (magit-remote-branch-p branch)
- (pcase-setq `(,remote . ,branch) (magit-split-branch-name branch))
- (unless (setq remote (or (magit-get-push-remote branch)
- (magit-get-upstream-remote branch)))
- (user-error "Cannot determine remote for %s" branch)))
- (forge--format (forge-get-repository :stub remote)
- 'branch-url-format
- `((?r . ,branch)))))
-
-(cl-defmethod forge-get-url ((_(eql :remote)) remote)
- (forge--format (forge-get-repository :stub remote) 'remote-url-format))
-
-(cl-defmethod forge-get-url ((post forge-post))
- (forge--format post (let ((topic (forge-get-parent post)))
- (cond ((forge--childp topic 'forge-issue)
- 'issue-post-url-format)
- ((forge--childp topic 'forge-pullreq)
- 'pullreq-post-url-format)))))
-
-(cl-defmethod forge-get-url ((notify forge-notification))
- (oref notify url))
-
-;;; Visit
-
-;;;###autoload
-(defun forge-visit-topic (topic)
- "Read a TOPIC and visit it.
-By default only offer active topics for completion. With a prefix
-argument offer all topics. While completion is in progress, \
-\\<forge-read-topic-minibuffer-map>\\[forge-read-topic-lift-limit] lifts
-the limitation to active topics."
- (interactive (list (forge-read-topic "View topic")))
- (forge-topic-setup-buffer (forge-get-topic topic)))
-
-;;;###autoload
-(defun forge-visit-issue (issue)
- "Read an ISSUE and visit it.
-By default only offer active issues for completion. With a prefix
-argument offer all topics. While completion is in progress, \
-\\<forge-read-topic-minibuffer-map>\\[forge-read-topic-lift-limit] lifts
-the limitation to active issues."
- (interactive (list (forge-read-issue "View issue")))
- (forge-topic-setup-buffer (forge-get-issue issue)))
-
-;;;###autoload
-(defun forge-visit-pullreq (pull-request)
- "Read a PULL-REQUEST and visit it.
-By default only offer active pull-requests for completion. With a
-prefix argument offer all topics. While completion is in progress,
-\\<forge-read-topic-minibuffer-map>\\[forge-read-topic-lift-limit] \
-lifts the limitation to active pull-requests."
- (interactive (list (forge-read-pullreq "View pull-request")))
- (forge-topic-setup-buffer (forge-get-pullreq pull-request)))
-
-;;;###autoload
-(defun forge-visit-this-topic (&optional menu)
- "Visit the topic at point.
-With prefix argument MENU, also show the topic menu."
- (interactive (list current-prefix-arg))
- (forge-topic-setup-buffer (forge-topic-at-point))
- (cond
- ((eq transient-current-command 'forge-topic-menu)
- (setq forge--quit-keep-topic-menu t))
- ((or menu
- (memq transient-current-command
- '(forge-topics-menu forge-notifications-menu)))
- (transient-setup 'forge-topic-menu))))
-
-;;;###autoload
-(defun forge-visit-this-repository ()
- "Visit the repository at point."
- (interactive)
- (let* ((repo (forge-repository-at-point))
- (worktree (forge-get-worktree repo)))
- (cond
- ((and (eq transient-current-command 'forge-repositories-menu)
- (forge-get-repository repo nil :tracked?))
- (if-let ((buffer (get-buffer (forge-topics-buffer-name repo))))
- (progn (switch-to-buffer buffer)
- (transient-setup 'forge-topics-menu))
- (forge-list-topics repo)))
- (worktree
- (magit-status-setup-buffer worktree))
- ((forge-get-repository repo nil :tracked?)
- (forge-list-topics repo))
- ((user-error "Not tracked and location of clone is unknown")))))
-
-;;; Create
-
-(defun forge-create-issue ()
- "Create a new issue for the current repository."
- (interactive)
- (let* ((repo (forge-get-repository :tracked))
- (buf (forge--prepare-post-buffer
- "new-issue"
- (forge--format repo "Create new issue on %p"))))
- (when buf
- (with-current-buffer buf
- (setq forge--buffer-post-object repo)
- (setq forge--submit-post-function #'forge--submit-create-issue))
- (forge--display-post-buffer buf))))
-
-(defun forge-create-pullreq (source target)
- "Create a new pull-request for the current repository."
- (interactive (forge-create-pullreq--read-args))
- (let* ((repo (forge-get-repository :tracked))
- (buf (forge--prepare-post-buffer
- "new-pullreq"
- (forge--format repo "Create new pull-request on %p")
- source target)))
- (with-current-buffer buf
- (setq forge--buffer-base-branch target)
- (setq forge--buffer-head-branch source)
- (setq forge--buffer-post-object repo)
- (setq forge--submit-post-function #'forge--submit-create-pullreq)
- (run-hooks 'forge-create-pullreq-hook))
- (forge--display-post-buffer buf)))
-
-(transient-define-suffix forge-create-pullreq-from-issue (issue source target)
- "Convert an existing ISSUE into a pull-request."
- :description "convert to pull-request"
- :if (lambda ()
- (and (forge--get-github-repository)
- (let ((issue (forge-current-issue)))
- (and issue (eq (oref issue state) 'open)
- issue))))
- (interactive (cons (forge-read-open-issue "Convert issue")
- (forge-create-pullreq--read-args)))
- (setq issue (forge-get-issue issue))
- (forge--create-pullreq-from-issue (forge-get-repository issue)
- issue source target))
-
-(defun forge-create-pullreq--read-args ()
- (let* ((source (magit-completing-read
- "Source branch"
- (magit-list-remote-branch-names)
- nil t nil 'magit-revision-history
- (or (and-let* ((d (magit-branch-at-point)))
- (if (magit-remote-branch-p d)
- d
- (magit-get-push-branch d t)))
- (and-let* ((d (magit-get-current-branch)))
- (if (magit-remote-branch-p d)
- d
- (magit-get-push-branch d t))))))
- (repo (forge-get-repository :tracked))
- (remote (oref repo remote))
- (targets (delete source (magit-list-remote-branch-names remote)))
- (target (magit-completing-read
- "Target branch" targets nil t nil 'magit-revision-history
- (let* ((d (cdr (magit-split-branch-name source)))
- (d (and (magit-branch-p d) d))
- (d (and d (magit-get-upstream-branch d)))
- (d (and d (if (magit-remote-branch-p d)
- d
- (magit-get-upstream-branch d))))
- (d (or d (concat remote "/"
- (or (oref repo default-branch)
- "master")))))
- (car (member d targets))))))
- (list source target)))
-
-(defun forge-create-post (&optional quote)
- "Create a new post on an existing topic.
-If the region is active, then quote that part of the post.
-Otherwise and with a prefix argument quote the post that
-point is currently on."
- (interactive (list current-prefix-arg))
- (unless (derived-mode-p 'forge-topic-mode)
- (user-error "This command is only available from topic buffers"))
- (let* ((topic forge-buffer-topic)
- (buf (forge--prepare-post-buffer
- (forge--format topic "%i;new-comment")
- (forge--format topic "New comment on #%i of %p")))
- (quote (cond
- ((not (magit-section-match 'post)) nil)
- ((use-region-p)
- (buffer-substring-no-properties (region-beginning)
- (region-end)))
- (quote
- (let ((section (magit-current-section)))
- (string-trim-right
- (buffer-substring-no-properties (oref section content)
- (oref section end))))))))
- (with-current-buffer buf
- (setq forge--buffer-post-object topic)
- (setq forge--submit-post-function #'forge--submit-create-post)
- (when quote
- (goto-char (point-max))
- (unless (bobp)
- (insert "\n"))
- (insert (replace-regexp-in-string "^" "> " quote) "\n\n")))
- (forge--display-post-buffer buf)))
-
-;;; Edit
-
-(defun forge-edit-post ()
- "Edit the current post."
- (interactive)
- (let* ((post (forge-post-at-point t))
- (buf (cl-typecase post
- (forge-topic
- (forge--prepare-post-buffer
- (forge--format post "%i")
- (forge--format post "Edit #%i of %p")))
- (forge-post
- (forge--prepare-post-buffer
- (forge--format post "%i;%I")
- (forge--format post "Edit comment on #%i of %p"))))))
- (with-current-buffer buf
- (setq forge--buffer-post-object post)
- (setq forge--submit-post-function #'forge--submit-edit-post)
- (erase-buffer)
- (when (cl-typep post 'forge-topic)
- (insert "# " (oref post title) "\n\n"))
- (insert (oref post body)))
- (forge--display-post-buffer buf)))
-
-(transient-define-suffix forge-edit-topic-note ()
- "Edit your private note about the current topic."
- :transient #'transient--do-quit-all
- :description
- (lambda ()
- (if-let ((topic (forge-current-topic)))
- (concat "note "
- (if-let ((note (oref topic note)))
- (propertize (substring note 0 (string-match-p "$" note))
- 'face 'font-lock-string-face)
- (propertize "none" 'face 'magit-dimmed)))
- "note"))
- (interactive)
- (if-let* ((topic (forge-current-topic t))
- (repo (forge-get-repository topic))
- (default-directory (forge-get-worktree repo))
- (buf (forge--prepare-post-buffer
- (forge--format topic "%i;note")
- (forge--format topic "New note on #%i of %p"))))
- (progn
- (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))
- (message "Cannot determine topic or worktree")))
-
-;;; Delete
-
-(transient-define-suffix forge-delete-comment ()
- "Delete the comment at point."
- :description "delete comment"
- :inapt-if-not #'forge-comment-at-point
- (interactive)
- (let ((comment (forge-comment-at-point t)))
- (when (yes-or-no-p "Really delete the current comment? ")
- (forge--delete-comment (forge-get-repository :tracked) comment))))
-
-;;; Branch
-
-;;;###autoload
-(defun forge-branch-pullreq (pullreq)
- "Create and configure a new branch from a pull-request.
-Please see the manual for more information."
- (interactive (list (forge-read-pullreq "Branch pull request")))
- (let ((pullreq (forge-get-pullreq pullreq)))
- (if-let ((branch (forge--pullreq-branch-active pullreq)))
- (progn (message "Branch %S already exists and is configured" branch)
- branch)
- (forge--branch-pullreq (forge-get-repository pullreq) pullreq)
- (forge-refresh-buffer))))
-
-(cl-defmethod forge--branch-pullreq ((pullreq forge-pullreq))
- (forge--branch-pullreq (forge-get-repository pullreq) pullreq))
-
-(cl-defmethod forge--branch-pullreq ((_repo forge-unusedapi-repository) pullreq)
- ;; We don't know enough to do a good job.
- (let* ((number (oref pullreq number))
- (branch (format "pr-%s" number)))
- (when (magit-branch-p branch)
- (user-error "Branch `%s' already exists" branch))
- (magit-git "branch" branch (forge--pullreq-ref pullreq))
- ;; More often than not this is the correct target branch.
- (magit-call-git "branch" branch "--set-upstream-to=master")
- (magit-set (number-to-string number) "branch" branch "pullRequest")
- branch))
-
-(cl-defmethod forge--branch-pullreq ((repo forge-repository) pullreq)
- (let* ((number (oref pullreq number))
- (branch-n (format "pr-%s" number))
- (branch (or (forge--pullreq-branch-internal pullreq) branch-n))
- (pullreq-ref (format "refs/pullreqs/%s" number)))
- (cond ((and-let* ((pr-branch (oref pullreq head-ref)))
- (string-search ":" pr-branch))
- ;; Such a branch name would be invalid. If we encounter
- ;; it anyway, then that means that the source branch and
- ;; the merge-request ref are missing. Luckily Gitlab no
- ;; longer does this, but we nevertheless have to deal
- ;; with merge-requests that have been lost in time.
- (error "Cannot check out this merge-request because %s"
- "on old Gitlab version discarded the source branch"))
- ((not (eq (oref pullreq state) 'open))
- (magit-git "branch" "--force" branch pullreq-ref))
- (t
- (let ((upstream (oref repo remote))
- (pr-remote (oref pullreq head-user))
- (pr-branch (oref pullreq head-ref)))
- (cond ((not (oref pullreq cross-repo-p))
- (let ((tracking (concat upstream "/" pr-branch)))
- (unless (magit-branch-p tracking)
- (magit-call-git "fetch" upstream))
- (forge--setup-pullreq-branch branch tracking)
- (magit-branch-maybe-adjust-upstream branch tracking)
- (magit-set upstream "branch" branch "pushRemote")
- (magit-set upstream "branch" branch "pullRequestRemote")))
- ((not pr-branch)
- ;; The pullreq branch (on Github) has been deleted.
- (setq pr-remote nil)
- (setq branch branch-n)
- (forge--setup-pullreq-branch branch pullreq-ref)
- (magit-set upstream "branch" branch "pushRemote"))
- (t
- ;; For prs within the upstream we are more permissive,
- ;; but any request to merge a branch with a well known
- ;; name from fork, is highly suspicious and likely the
- ;; result of a contributor not bothering to name their
- ;; feature branch.
- (when (and (member branch magit-main-branch-names)
- (magit-branch-p branch))
- (setq branch branch-n))
- (forge--setup-pullreq-remote pullreq)
- (forge--setup-pullreq-branch
- branch (concat pr-remote "/" pr-branch))
- (if (and (oref pullreq editable-p)
- (equal branch pr-branch))
- (magit-set pr-remote "branch" branch "pushRemote")
- (magit-set upstream "branch" branch "pushRemote"))))
- (when pr-remote
- (magit-set pr-remote "branch" branch "pullRequestRemote"))
- (magit-set "true" "branch" branch "rebase")
- (magit-git "branch" branch
- (let ((base-ref (oref pullreq base-ref)))
- (concat "--set-upstream-to="
- (if (or magit-branch-prefer-remote-upstream
- (not (magit-branch-p base-ref)))
- (concat upstream "/" base-ref)
- base-ref)))))))
- (magit-set (number-to-string number) "branch" branch "pullRequest")
- (magit-set (oref pullreq title) "branch" branch "description")
- branch))
-
-(defun forge--setup-pullreq-branch (branch tracking)
- (if (magit-branch-p branch)
- (unless (magit-rev-equal branch tracking)
- (message "Existing branch %s diverged from %s" branch tracking))
- (magit-git "branch" branch tracking)))
-
-(defun forge--setup-pullreq-remote (pullreq)
- (let* ((pr-remote (oref pullreq head-user))
- (pr-branch (oref pullreq head-ref))
- (repo (forge-get-repository pullreq))
- (host (oref repo githost))
- (user (oref pullreq head-user))
- (fork (oref pullreq head-repo)))
- (if (magit-remote-p pr-remote)
- (let ((url (magit-git-string "remote" "get-url" pr-remote))
- (fetch (magit-get-all "remote" pr-remote "fetch")))
- (unless (equal (forge--split-forge-url url)
- (list host user (substring fork (1+ (length user)))))
- (user-error "Remote `%s' already exists but does not point to %s"
- pr-remote url))
- (unless (or (member (format "+refs/heads/*:refs/remotes/%s/*"
- pr-remote)
- fetch)
- (member (format "+refs/heads/%s:refs/remotes/%s/%s"
- pr-branch pr-remote pr-branch)
- fetch))
- (magit-git "remote" "set-branches" "--add" pr-remote pr-branch)
- (magit-git "fetch" pr-remote)))
- (let ((url (magit-git-string "remote" "get-url" (oref repo remote))))
- (magit-git
- "remote" "add" "-f" "--no-tags"
- "-t" pr-branch pr-remote
- (cond ((or (string-prefix-p "git@" url)
- (string-prefix-p "ssh://git@" url))
- (format "git@%s:%s.git" host fork))
- ((string-prefix-p "https://" url)
- (format "https://%s/%s.git" host fork))
- ((string-prefix-p "git://" url)
- (format "git://%s/%s.git" host fork))
- ((string-prefix-p "http://" url)
- (format "http://%s/%s.git" host fork))
- ((error "%s has an unexpected format" url))))))))
-
-;;;###autoload
-(defun forge-checkout-pullreq (pullreq)
- "Create, configure and checkout a new branch from a pull-request.
-Please see the manual for more information."
- (interactive (list (forge-read-pullreq "Checkout pull request")))
- (magit--checkout (forge--branch-pullreq (forge-get-pullreq pullreq)))
- (forge-refresh-buffer))
-
-;;;###autoload(autoload 'forge-checkout-this-pullreq "forge-commands" nil t)
-(transient-define-suffix forge-checkout-this-pullreq ()
- "Checkout the current pull-request.
-If the branch for that pull-request does not exist yet, then create and
-configure it first."
- :description "checkout"
- :inapt-if-not #'forge-current-pullreq
- (interactive)
- (forge-checkout-pullreq (forge-current-topic t)))
-
-;;;###autoload
-(defun forge-checkout-worktree (path pullreq)
- "Create, configure and checkout a new worktree from a pull-request.
-This is like `forge-checkout-pullreq', except that it also
-creates a new worktree. Please see the manual for more
-information."
- (interactive
- (let ((id (forge-read-pullreq "Checkout pull request")))
- (list (funcall forge-checkout-worktree-read-directory-function
- (forge-get-pullreq id))
- id)))
- (when (and (file-exists-p path)
- (not (and (file-directory-p path)
- (length= (directory-files path) 2))))
- (user-error "%s already exists and isn't empty" path))
- (magit-worktree-checkout path
- (forge--branch-pullreq (forge-get-pullreq pullreq))))
-
-(defun forge-checkout-worktree-default-read-directory-function (pullreq)
- (pcase-let* (((eieio number head-ref) pullreq)
- (path (read-directory-name
- (format "Checkout #%s in new worktree: " number)
- (file-name-directory
- (directory-file-name default-directory))
- nil nil
- (let ((branch (forge--pullreq-branch-internal pullreq)))
- (if (string-match-p "\\`pr-[0-9]+\\'" branch)
- (number-to-string number)
- (format "%s-%s" number
- (string-replace "/" "-" head-ref)))))))
- (when (equal path "")
- (user-error "The empty string isn't a valid path"))
- path))
-
-;;; Marks
-
-(defun forge-create-mark (name face description)
- "Define a new mark that topics can be marked with."
- (interactive
- (list (read-string "Name: ")
- (magit-read-char-case "Set appearance using " nil
- (?n "a face [n]ame"
- (read-face-name "Face name: "))
- (?s "face [s]exp"
- (read-from-minibuffer
- "Face sexp: "
- "(:background \"\" :foreground \"\" :box t)"
- read-expression-map t)))
- (let ((str (read-string "Description: ")))
- (and (not (equal str "")) str))))
- (forge-sql [:insert-into mark :values $v1]
- (vector nil (forge--uuid) name face description)))
-
-(defun forge-edit-mark (id name face description)
- "Define a new mark that topics can be marked with."
- (interactive
- (pcase-let*
- ((marks (forge-sql [:select [name id face description] :from mark]))
- (`(,name ,id ,face ,description)
- (assoc (completing-read "Edit mark" (mapcar #'car marks) nil t)
- marks)))
- (list id
- (read-string "Name: " name)
- (magit-read-char-case "Set appearance using " nil
- (?n "a face [n]ame"
- (read-face-name "Face name: " (and (symbolp face) face)))
- (?s "face [s]exp"
- (read-from-minibuffer
- "Face sexp: "
- (if (listp face)
- (format "%S" face)
- "(:background \"\" :foreground \"\" :box t)")
- read-expression-map t)))
- (let ((str (read-string "Description: " nil nil description)))
- (and (not (equal str "")) str)))))
- (forge-sql [:update mark
- :set (= [name face description] $v1)
- :where (= id $s2)]
- (vector name face description) id))
-
-;;; Remotely
-
-;;;###autoload
-(defun forge-fork (fork remote)
- "Fork the current repository to FORK and add it as a REMOTE.
-If the fork already exists, then that isn't an error; the remote
-is added anyway. Currently this only supports Github and Gitlab."
- (interactive
- (let ((fork (magit-completing-read "Fork to"
- (mapcar #'car forge-owned-accounts))))
- (list fork
- (read-string "Remote name: "
- (or (plist-get (cdr (assoc fork forge-owned-accounts))
- 'remote-name)
- fork)))))
- (let ((repo (forge-get-repository :stub)))
- (forge--fork-repository repo fork)
- (magit-remote-add remote
- (magit-clone--format-url (oref repo githost) fork
- (oref repo name))
- (list "--fetch"))))
-
-;;;###autoload(autoload 'forge-merge "forge-commands" nil t)
-(transient-define-suffix forge-merge (pullreq method)
- "Merge the current pull-request using METHOD using the forge's API.
-
-If there is no current pull-request or with a prefix argument,
-then read pull-request PULLREQ to visit instead.
-
-Use of this command is discouraged. Unless the remote repository
-is configured to disallow that, you should instead merge locally
-and then push the target branch. Forges detect that you have
-done that and respond by automatically marking the pull-request
-as merged."
- (interactive
- (list (forge-read-pullreq "Merge pull-request")
- (if (forge--childp (forge-get-repository :tracked)
- 'forge-gitlab-repository)
- (magit-read-char-case "Merge method " t
- (?m "[m]erge" 'merge)
- (?s "[s]quash" 'squash))
- (magit-read-char-case "Merge method " t
- (?m "[m]erge" 'merge)
- (?s "[s]quash" 'squash)
- (?r "[r]ebase" 'rebase)))))
- (let ((pullreq (forge-get-pullreq pullreq)))
- (forge--merge-pullreq (forge-get-repository pullreq)
- pullreq
- (magit-rev-hash
- (forge--pullreq-branch-internal pullreq))
- method))
- (forge-pull))
-
-;;;###autoload
-(defun forge-rename-default-branch ()
- "Rename the default branch to NEWNAME.
-Change the name on the upstream remotely and locally, and update the
-upstream remotes of local branches accordingly."
- (interactive)
- (let* ((repo (forge-get-repository :tracked?))
- (_ (unless (forge-github-repository-p repo)
- (user-error "Updating default branch not supported for forge `%s'"
- (oref repo forge))))
- (remote (or (and (fboundp 'forge--get-remote)
- (forge--get-remote))
- (magit-get-some-remote)
- (user-error "No remote configured")))
- (symref (format "refs/remotes/%s/HEAD" remote))
- (oldhead (progn
- (message "Determining old default branch...")
- (magit-git "fetch" "--prune")
- (magit-git "remote" "set-head" "--auto" remote)
- (message "Determining old default branch...done")
- (magit-git-string "symbolic-ref" "--short" symref)))
- (oldname (if oldhead
- (cdr (magit-split-branch-name oldhead))
- (error "Cannot determine old default branch")))
- (default (and (not (equal oldname "main")) "main"))
- (newname (read-string
- (format "Rename default branch `%s' to%s: "
- oldname
- (if default (format " (default: %s)" default) ""))
- nil nil default)))
- (message "Renaming default branch...")
- (forge--set-default-branch repo newname oldname)
- (forge-refresh-buffer)
- (message "Renaming default branch...done")))
-
-;;; Configuration
-
-(transient-define-suffix forge-forge.remote ()
- "Change the local value of the `forge.remote' Git variable."
- :class 'magit--git-variable:choices
- :variable "forge.remote"
- :choices #'magit-list-remotes
- :default (lambda (_) (forge--get-remote t t))
- (interactive)
- (let ((obj (transient-suffix-object)))
- (transient-infix-set obj (transient-infix-read obj)))
- (if (and transient--prefix
- (eq (oref transient--prefix command) 'forge-add-repository))
- ;; Improvements to Transient will make this hack unnecessary.
- (let ((scope (forge-add-repository--scope)))
- (oset (transient-prefix-object) scope scope))
- (transient--show)))
-
-(transient-define-infix forge-forge.graphqlItemLimit ()
- "Change the maximum number of GraphQL entities to pull at once."
- :if #'forge--get-github-repository
- :class 'magit--git-variable
- :variable "forge.graphqlItemLimit"
- :reader #'read-string
- :default (lambda () (number-to-string ghub-graphql-items-per-request)))
-
-(transient-define-suffix forge-toggle-display-in-status-buffer ()
- "Toggle whether to display topics in the current status buffer."
- :if-mode 'magit-status-mode
- :inapt-if-not #'forge--buffer-with-topics-sections-p
- :description (lambda ()
- (if (and forge--buffer-topics-spec
- (oref forge--buffer-topics-spec type))
- "hide topics"
- "display topics"))
- (interactive)
- (oset forge--buffer-topics-spec type
- (if (oref forge--buffer-topics-spec type) nil 'topic))
- (forge-refresh-buffer))
-
-(defun forge--buffer-with-topics-sections-p ()
- (and forge--buffer-topics-spec
- (not (eq major-mode 'forge-topics-mode))
- (forge-get-repository :tracked?)))
-
-;;;###autoload(autoload 'forge-add-pullreq-refspec "forge-commands" nil t)
-(transient-define-suffix forge-add-pullreq-refspec ()
- "Configure Git to fetch all pull-requests.
-This is done by adding \"+refs/pull/*/head:refs/pullreqs/*\"
-to the value of `remote.REMOTE.fetch', where REMOTE is the
-upstream remote."
- :if-not 'forge--pullreq-refspec
- :description "add pull-request refspec"
- (interactive)
- (let* ((repo (forge-get-repository :stub))
- (remote (oref repo remote))
- (fetch (magit-get-all "remote" remote "fetch"))
- (refspec (oref repo pullreq-refspec)))
- (if (member refspec fetch)
- (message "Pull-request refspec is already active")
- (magit-call-git "config" "--add"
- (format "remote.%s.fetch" remote)
- refspec)
- (magit-git-fetch remote (magit-fetch-arguments)))))
-
-(defun forge--pullreq-refspec ()
- (let* ((repo (forge-get-repository :stub))
- (remote (oref repo remote))
- (fetch (magit-get-all "remote" remote "fetch"))
- (refspec (oref repo pullreq-refspec)))
- (car (member refspec fetch))))
-
-;;; Add repositories
-
-;;;###autoload(autoload 'forge-add-repository "forge-commands" nil t)
-(transient-define-prefix forge-add-repository (&optional repo limit)
- "Add a repository to the database."
- :refresh-suffixes t
- [:class transient-subgroups
-
- ;; Already tracked.
- [:if (lambda () (forge--scope :tracked))
- (:info*
- (lambda ()
- (format
- (propertize "%s is already being tracked" 'face 'transient-heading)
- (propertize (forge--scope 'url) 'face 'bold)))
- :format "%d")]
-
- ;; Nothing to tracked.
- [:if-not (lambda () (forge--scope 'topdir))
- (:info*
- (lambda ()
- (format
- (propertize "%s is not inside a Git repository" 'face 'transient-heading)
- (propertize default-directory 'face 'bold)))
- :format "%d")]
-
- ;; Cannot track.
- [:if (lambda () (and (not (forge--scope 'repo)) (forge--scope 'topdir)))
- :description
- (lambda ()
- (concat
- (format (propertize "Cannot determine forge host for %s\n"
- 'face 'transient-heading)
- (propertize (forge--scope 'topdir) 'face 'bold))
- (if-let* ((remote (forge--get-remote))
- (url (magit-git-string "remote" "get-url" remote)))
- (format (propertize "because %s is not on a host known to Forge."
- 'face 'transient-heading)
- (propertize url 'face 'bold))
- (propertize "because no suitable remote was detected."
- 'face 'transient-heading))))
- ("r" forge-forge.remote :format " %k Try another %d %v" :face 'bold)
- ("h" "Learn how to configure another Github host"
- (lambda () (interactive) (info "(forge)Setup for Another Github Instance")))
- ("l" "Learn how to configure another Gitlab host"
- (lambda () (interactive) (info "(forge)Setup for Another Gitlab Instance")))
- ("p" "Learn how to configure partially supported host"
- (lambda () (interactive) (info "(forge)Setup a Partially Supported Host")))]
-
- ;; Track it!
- [:if (lambda () (forge--scope :untracked))
- :description
- (lambda ()
- (format
- (propertize "Adding %s to database," 'face 'transient-heading)
- (propertize (forge--scope 'url) 'face 'bold)))
- ("r" forge-forge.remote :format " %k from %d %v," :face 'bold)
- ("a" "pulling all topics"
- (lambda (repo)
- (interactive (list (forge--scope 'repo)))
- (forge-add-repository repo)))
- ("s" "pulling only topics since <date>"
- (lambda (repo date)
- (interactive
- (list (forge--scope 'repo)
- (forge-read-date "Limit pulling to topics updated since: ")))
- (forge-add-repository repo date)))
- ("i" "to allow pulling of individual topics"
- (lambda (repo)
- (interactive (list (forge--scope 'repo)))
- (forge-add-repository repo :selective)))]
-
- ;; Pivot.
- [("o" "Add another repository" forge-add-some-repository)
- (7 "U" "Add all source repositories belonging to a user"
- forge-add-user-repositories)
- (7 "O" "Add all source repositories belonging to an organization"
- forge-add-organization-repositories)]]
- (declare (interactive-only nil))
- (interactive)
- (cond
- ((not repo)
- (transient-setup 'forge-add-repository nil nil
- :scope (forge-add-repository--scope)))
- ((stringp repo)
- (transient-setup 'forge-add-repository nil nil
- :scope (forge-add-repository--scope repo)))
- (t
- (when-let*
- (((not (eq limit :selective)))
- ((magit-git-config-p "forge.autoPull" t))
- (remote (oref repo remote))
- (refspec (oref repo pullreq-refspec))
- (default-directory (forge-get-worktree repo))
- ((and (not (member refspec (magit-get-all "remote" remote "fetch")))
- (or (eq forge-add-pullreq-refspec t)
- (and (eq forge-add-pullreq-refspec 'ask)
- (y-or-n-p (format "Also add %S refspec? " refspec)))))))
- (magit-call-git "config" "--add"
- (format "remote.%s.fetch" remote)
- refspec))
- (setq repo (forge-get-repository repo nil :insert!))
- (when (eq limit :selective)
- (oset repo selective-p t)
- (setq limit nil))
- (forge--pull repo
- (and (not (forge-get-worktree repo)) #'ignore)
- limit))))
-
-(defun forge-add-repository--scope (&optional directory)
- (let* ((repo (if directory
- (forge-get-repository directory nil :stub?)
- (forge-get-repository :stub?)))
- (wtree (and repo (forge-get-worktree repo)))
- (condition (and repo (oref repo condition)))
- (val
- `((repo . ,repo)
- (wtree . ,wtree)
- (condition . ,condition)
- (:tracked . ,(eq condition :tracked))
- (:untracked . ,(memq condition '(:known :stub)))
- (topdir . ,(or wtree (magit-toplevel)))
- (url . ,(and repo (forge-get-url repo))))))
- val))
-
-(defun forge--scope (&optional key)
- ;; `transient-scope' itself probably offer optional KEY.
- (let ((scope (transient-scope)))
- (if key (alist-get key scope) scope)))
-
-(defun forge-add-some-repository (url)
- "Read a repository and add it to the database."
- (interactive
- (let (ret url)
- (while (not ret)
- (setq url (magit-read-string-ns
- "Add repository to database (url, owner/name, or name)" url))
- (unless (string-match-p "\\(://\\|@\\)" url)
- (setq url (magit-clone--name-to-url url)))
- (cond ((forge-get-repository url nil :tracked?)
- (message "%s is already being tracked locally"
- (propertize url 'face 'bold))
- (sit-for 3))
- ((not (forge-get-repository url nil :valid?))
- (message "%s does not exist or is inaccessible"
- (propertize url 'face 'bold))
- (sit-for 3))
- ((setq ret url))))
- (list ret)))
- (forge-add-repository url))
-
-;;;###autoload
-(defun forge-add-user-repositories (host user)
- "Add all of USER's repositories from HOST to the database.
-This may take a while. Only Github is supported at the moment."
- (interactive
- (list (forge-read-host "Add repositories from Github host"
- 'forge-github-repository)
- (read-string "User: ")))
- (forge--add-user-repos 'forge-github-repository host user))
-
-;;;###autoload
-(defun forge-add-organization-repositories (host organization)
- "Add all of ORGANIZATION's repositories from HOST to the database.
-This may take a while. Only Github is supported at the moment."
- (interactive
- (list (forge-read-host "Add repositories from Github host"
- 'forge-github-repository)
- (read-string "Organization: ")))
- (forge--add-organization-repos 'forge-github-repository host organization))
-
-;;; Cleanup
-
-;;;###autoload
-(defun forge-remove-repository (repository)
- "Remove a repository from the database."
- (interactive
- (pcase-let* ((repo (forge-read-repository "Remove repository from db"))
- ((eieio githost owner name) repo))
- (if (yes-or-no-p (format "Do you really want to remove \"%s/%s @%s\" %s? "
- owner name githost "from the database"))
- (list repo)
- (user-error "Abort"))))
- (closql-delete repository)
- (forge-refresh-buffer))
-
-;;;###autoload
-(defun forge-remove-topic-locally (topic)
- "Remove a topic from the local database only.
-Due to how the supported APIs work, it would be too expensive to
-automatically remove topics from the local database that were
-removed from the forge. The purpose of this command is to allow
-you to manually clean up the local database."
- (interactive (list (forge-read-topic "Delete topic LOCALLY only")))
- (setq topic (forge-get-topic topic))
- (closql-delete topic)
- (if (and (derived-mode-p 'forge-topic-mode)
- (eq (oref topic id)
- (oref forge-buffer-topic id)))
- (kill-buffer (current-buffer))
- (forge-refresh-buffer)))
-
-;;;###autoload
-(defun forge-reset-database ()
- "Move the current database file to the trash.
-This is useful after the database scheme has changed, which will
-happen a few times while the forge functionality is still under
-heavy development."
- (interactive)
- (when (and (file-exists-p forge-database-file)
- (yes-or-no-p "Really trash Forge's database file? "))
- (when-let ((db (forge-db t)))
- (emacsql-close db))
- (delete-file forge-database-file t)
- (forge-refresh-buffer)))
-
-;;; Miscellaneous
-
-(magit-define-section-jumper forge-jump-to-pullreqs "Pull requests" pullreqs)
-(magit-define-section-jumper forge-jump-to-issues "Issues" issues)
-
-;;; _
-(provide 'forge-commands)
-;;; forge-commands.el ends here
+++ /dev/null
-;;; forge-core.el --- Core functionality -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2024 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This file is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this file. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'magit)
-
-(require 'cl-lib)
-(require 'compat)
-(require 'dash)
-(require 'eieio)
-(require 'seq)
-(require 'subr-x)
-
-(require 'transient)
-
-(require 'forge-db)
-
-(eval-when-compile
- (cl-pushnew 'id eieio--known-slot-names)
- (cl-pushnew 'name eieio--known-slot-names)
- (cl-pushnew 'number eieio--known-slot-names)
- (cl-pushnew 'owner eieio--known-slot-names)
- (cl-pushnew 'worktree eieio--known-slot-names))
-
-;;; Options
-
-(defgroup forge nil
- "Options concerning Git forges."
- :group 'magit)
-
-(defgroup forge-faces nil
- "Faces concerning Git forges."
- :group 'forge
- :group 'magit-faces)
-
-(defcustom forge-alist
- '(;; Forges
- ("github.com" "api.github.com"
- "github.com" forge-github-repository)
- ("gitlab.com" "gitlab.com/api/v4"
- "gitlab.com" forge-gitlab-repository)
- ("salsa.debian.org" "salsa.debian.org/api/v4"
- "salsa.debian.org" forge-gitlab-repository)
- ("framagit.org" "framagit.org/api/v4"
- "framagit.org" forge-gitlab-repository)
- ("gitlab.gnome.org" "gitlab.gnome.org/api/v4"
- "gitlab.gnome.org" forge-gitlab-repository)
- ;; Forges (API unsupported)
- ("codeberg.org" "codeberg.org/api/v1"
- "codeberg.org" forge-gitea-repository)
- ("bitbucket.org" "api.bitbucket.org/2.0"
- "bitbucket.org" forge-bitbucket-repository)
- ;; Semi-Forges
- ("git.savannah.gnu.org" nil
- "git.savannah.gnu.org" forge-cgit**-repository)
- ("git.kernel.org" nil
- "git.kernel.org" forge-cgit-repository)
- ("repo.or.cz" nil
- "repo.or.cz" forge-repoorcz-repository)
- ("git.suckless.org" nil
- "git.suckless.org" forge-stagit-repository)
- ("git.sr.ht" nil
- "git.sr.ht" forge-srht-repository))
- "List of Git forges.
-
-Each entry has the form (GITHOST APIHOST WEBHOST CLASS).
-
-- GITHOST is the host used to access repositories on the forge using
- Git.
-
-- APIHOST is the host used to access the forge's API. For some forges
- the isn't just a host, but a host followed by the path to the API's
- endpoint.
-
-- WEBHOST is the host used to access repositories on this forge using
- a browser. The IDs used to identify repositories from the forge in
- the local database also derives from this value.
-
-- CLASS is the class to be used for repositories from the forge.
-
-Complications:
-
-- When connecting to a Github Enterprise edition whose REST API's
- end point is \"<host>/v3\" and whose GraphQL API's end point is
- \"<host>/graphql\", then use \"<host>/v3\" as APIHOST. This is a
- historic accident. See issue #174.
-
-- WEBHOST and CLASS cannot be changed once you have added one or
- more repositories from a forge. Changing GITHOST and/or APIHOST
- may be possible, but should seldom be necessary."
- :package-version '(forge . "0.1.0")
- :group 'forge
- :type '(repeat (list (string :tag "Git host")
- (choice (string :tag "API endpoint")
- (const :tag "No API" nil))
- (string :tag "ID")
- (symbol :tag "Repository class"))))
-
-;;; Class
-
-(defclass forge-object (closql-object) () :abstract t)
-
-(defmacro forge--childp (obj type)
- "Somewhat similar to `cl-typep' but only for (possibly unknown) classes.
-TYPE is evaluated at macro-expansion time but, unlike with
-`cl-typep', the respective class does not have to be defined
-at that time."
- (let ((fn (intern (concat (symbol-name (eval type)) "--eieio-childp"))))
- `(and (fboundp ',fn) (,fn ,obj))))
-
-;;; Query
-
-(cl-defgeneric forge-get-parent (object)
- "Return the parent object of OBJECT.
-The hierarchy is repository > topic > post.
-For other objects return nil.")
-
-(cl-defgeneric forge-get-repository (demand)
- "Return a forge repository object or nil, or signal an error.
-
-A forge repository is a repository hosted on a forge. The local clone
-is also a \"repository\", but it is a \"Git\" repository, not a \"Forge\"
-repository. (Forge repositories are also Git repositories, but not the
-other way around.)
-
-A `:known' repository has an entry in the local database. All other
-repositories are unknown. `:known' repositories are divided into two
-subgroups: `:tracked' and \"untracked\" repositories.
-
-A `:tracked' repository was previously explicitly added to the database
-by the user.
-
-When Forge encounters a repository, without being instructed by the user
-to track it, it may nevertheless add limited information about it to the
-database. Such a repository is `:known' but it is not `:tracked'.
-
-Other repositories are \"unknown\". Most commands can only deal with
-repositories that are stored in the database. Of these, some can deal
-with any `:known' repositories, others require that they are `:tracked'.
-
-Some other commands exist — such as the browse commands — that have no
-such requirement. While such commands also require a repository object,
-they do not care whether that is stored in the database. Instead they
-are happy to use a `:stub' repository; a repository that is not stored
-in the database.
-
-The DEMAND argument specifies what kind of repository object the caller
-requires, at least. `:tracked' is greater than `:known', which is
-greater than `:stub'. For example, if the caller requests a `:known'
-repository, a `:tracked' repository will do, while a `:stub' repository
-will not.
-
-The valid values for DEMAND are:
-
-- `:tracked' and `:tracked?' request a repository that the user added
- to the database. If there is no such repository, the former causes
- an error to be signaled, while for the latter nil is returned.
-
-- `:known?' and `:insert!' request a repository from the database.
- Whether the user explicitly added it does not matter. If there is no
- such repository, nil is returned for the former, while for the latter
- a new repository is inserted into the repository and then returned.
-
-- `:stub' and `:stub?' request the Forge repository corresponding to
- the current Git repository. It does not matter whether it is known.
- This fails if `default-directory' is not inside a Git repository, if
- there is no matching entry in `forge-alist', or if it is unclear which
- remote to use. If the repository cannot be determined, the former
- causes an error to be signaled, while for the latter nil is returned.
-
- Stub repository objects are created without making an API request, so
- we lack access to the upstream ID, which the IDs used in out database,
- derive from. Stub repositories are \"unknown\" in the sense that their
- IDs are not `:known'. This is done to allow offline operations.
-
-- `:valid?' requests the Forge repository corresponding to the current
- Git repository. It does not matter whether it is known. If it is
- unknown, an API request is made to verify that the repository exists
- on the forge. If it does, an object with a valid upstream ID is
- returned, but that isn't inserted into the database. If not, nil is
- returned.
-
-Given a repository object, you can query its `condition' slot to learn
-whether it is `:tracked', `:known' (i.e., has a valid ID and is stored
-in the database), or merely a `:stub'.
-
-You can also use (forge-get repository OBJECT nil DEMAND) to check the
-condition of a repository object, or even to ensure a repository object
-has a valid upstream ID (using `:valid?'), or that it is tracked in the
-database (using `:insert!').
-
-Use `forge-repository-equal' to check if two objects refer to the same
-repository.
-
-Also see info node `(forge) Repository Detection'.")
-
-(cl-defgeneric forge-get-topic ()
- "Return a forge issue or pullreq object.")
-
-(cl-defgeneric forge-get-issue ()
- "Return a forge issue object.")
-
-(cl-defgeneric forge-get-pullreq ()
- "Return a forge pullreq object.")
-
-(defun forge--get-forge-host (host &optional demand)
- "Return `forge-alist' entry matching HOST.
-
-Entries have the form (GITHOST APIHOST WEBHOST CLASS).
-
-- If HOST matches a GITHOST, return the corresponding entry.
-- Else, if HOST is an ssh alias and the canonical hostname matches a
- GITHOST, return the corresponding entry.
-- Finally, if HOST matches a WEBHOST, return the corresponding entry.
-
-If no entry matches, return nil, or signal an error if optional DEMAND
-is non-nil."
- (or (assoc host forge-alist)
- (assoc (seq-some (lambda (line)
- (and (string-prefix-p "hostname" line)
- (substring line 9)))
- (ignore-errors
- (process-lines-ignore-status "ssh" "-G" host)))
- forge-alist)
- (car (cl-member host forge-alist :test #'equal :key #'caddr))
- (and demand
- (error "No entry for \"%s\" in `forge-alist'" host))))
-
-(defun forge--split-forge-url (url &optional relax)
- (save-match-data
- (cond
- ((string-match
- (concat "\\`"
- "\\(?:git://\\|"
- "[^/@]+@\\|"
- "\\(?:ssh\\|ssh\\+git\\|git\\+ssh\\)://\\(?:[^/@]+@\\)?\\|"
- "https?://\\(?:[^/@]+@\\)?\\)?"
- (if relax
- "\\(?1:[^:/]+\\)"
- (regexp-opt (mapcar #'car forge-alist) t))
- "\\(?::[0-9]+\\)?"
- "\\(?:/\\|:/?\\)"
- "~?\\(?2:.+?\\)/"
- "\\(?3:[^/]+?\\)"
- "\\(?:\\.git\\|/\\)?"
- "\\'")
- url)
- (and-let* ((elt (forge--get-forge-host (match-string 1 url) (not relax))))
- ;; Return the WEBHOST (not the GITHOST, URLs passed to this
- ;; function usually contain a GITHOST) because the IDs used to
- ;; identify a repository in the database are based on WEBHOSTs.
- (list (caddr elt)
- (match-string 2 url)
- (match-string 3 url))))
- ((not relax)
- ;; The host part didn't match any GITHOST in `forge-alist', but it
- ;; might be a ssh host alias. We have to relax strictness; in the
- ;; extremely unlikely case that there is a common path between the
- ;; HOST and the OWNER for this forge, we would incorrectly end up
- ;; making that path part of the owner.
- (forge--split-forge-url url t)))))
-
-;;; Identity
-
-(cl-defgeneric forge--object-id (class &rest args)
- "Return the database id for the CLASS object specified by ARGS.")
-
-(cl-defgeneric forge--repository-ids ( class host owner name
- &optional stub noerror)
- "Return the database and forge ids for the specified CLASS object.")
-
-(cl-defmethod magit-section-ident-value ((obj forge-object))
- "Return the value ob OBJ's `id' slot.
-Using OBJ itself would not be appropriate because multiple
-non-equal objects may exist, representing the same thing."
- (oref obj id))
-
-(defun forge--set-id-slot (repo object slot rows)
- "Set the value in OBJECT for SLOT to VALUE, actually storing foreign keys."
- ;; TODO Should CloSQL advice `oset' to make this unnecessary?
- (let ((repo-id (oref repo id)))
- (closql-oset
- object slot
- (mapcar (lambda (val)
- (forge--object-id repo-id
- (if (atom val) val (alist-get 'id val))))
- rows))))
-
-;;; Format
-
-(cl-defgeneric forge--format (object slot &optional spec)
- "Return a string based on SPEC and the format-string in OBJECT's SLOT.
-The available `format'-like specs depend on the type of OBJECT.
-SPEC can be used to add additional specs, as for `format-spec'.
-The latter override the former. SLOT is expected to be class-
-allocated. Some methods also accept a format string in place
-of SLOT.")
-
-(cl-defmethod forge--format-resource ((object forge-object) resource)
- "Return an API resource based on RESOURCE and slots of OBJECT.
-For use in `forge--FORGE-METHOD' such as `forge--ghub-get'.
-RESOURCE is a string separated by slashes. Each part that begins
-with a colon is replaced with a value from OBJECT. `:repo' is a
-synonym for `:name'. `:project' is a like `:owner/:name', but the
-slash is quoted on Gitlab. `:topic' is a synonym for `:number'
-but only if OBJECT is a topic. Any other `:SLOT' means to use
-the value of that slot in OBJECT, or if that doesn't exist in its
-parent object (determined using `forge-get-parent')."
- (save-match-data
- (setq resource
- (replace-regexp-in-string
- ":\\([^/]+\\)"
- (lambda (str)
- (let ((slot (intern (substring str 1))))
- (or (and-let*
- ((v (ignore-errors
- (pcase slot
- ('repo (oref object name))
- ('project (concat (string-replace
- "/" "%2F" (oref object owner))
- "%2F"
- (oref object name)))
- ('topic (and (forge--childp object 'forge-topic)
- (oref object number)))
- (_ (eieio-oref object slot))))))
- (format "%s" v))
- str)))
- resource t t))
- (if (string-match ":[^/]*" resource)
- (if-let ((parent (ignore-errors (forge-get-parent object))))
- (forge--format-resource parent resource)
- (error "Cannot resolve %s for a %s"
- (match-string 0 resource)
- (eieio-object-class object)))
- resource)))
-
-;;; Miscellaneous
-
-(defun forge-refresh-buffer (&optional buffer)
- "Refresh the current buffer, if it is a Magit or Forge buffer.
-Refresh the buffer if its major-mode derives from `magit-mode'
-or `forge-repository-list-mode'. If optional BUFFER is non-nil,
-then refresh that buffer, provided it is alive and satisfies
-the mode requirement."
- (interactive)
- (cond (buffer
- (when (buffer-live-p buffer)
- (with-current-buffer buffer
- (forge-refresh-buffer))))
- ((derived-mode-p 'forge-topic-mode)
- (magit-refresh-buffer))
- ((derived-mode-p 'magit-mode)
- (magit-refresh-buffer))
- ((and (derived-mode-p 'forge-topic-mode)
- (boundp 'forge--buffer-topics-spec)
- (oref forge--buffer-topics-spec global))
- (revert-buffer))
- ((derived-mode-p 'forge-repository-list-mode)
- (revert-buffer))))
-
-(defun forge--sanitize-string (string)
- ;; For Gitlab this may also be nil.
- (if string (string-replace "\r\n" "\n" string) ""))
-
-(defun forge--uuid ()
- "Return string with random (version 4) UUID."
- ;; This is a copy of `org-id-uuid'.
- ;; Only used in `forge-create-mark'.
- (let ((rnd (md5 (format "%s%s%s%s%s%s%s"
- (random)
- (current-time)
- (user-uid)
- (emacs-pid)
- (user-full-name)
- user-mail-address
- (recent-keys)))))
- (format "%s-%s-4%s-%s%s-%s"
- (substring rnd 0 8)
- (substring rnd 8 12)
- (substring rnd 13 16)
- (format "%x"
- (logior
- #b10000000
- (logand
- #b10111111
- (string-to-number
- (substring rnd 16 18) 16))))
- (substring rnd 18 20)
- (substring rnd 20 32))))
-
-;;; _
-(provide 'forge-core)
-;;; forge-core.el ends here
+++ /dev/null
-;;; forge-db.el --- Database implementation -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2024 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This file is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this file. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'closql)
-(require 'compat)
-(require 'eieio)
-(require 'emacsql)
-
-;; For `closql--db-update-schema':
-(declare-function forge--object-id "forge-core")
-(declare-function forge-get-issue "forge-core")
-(declare-function forge-get-pullreq "forge-core")
-(declare-function forge-get-repository "forge-core" (demand))
-
-(eval-when-compile
- (cl-pushnew 'number eieio--known-slot-names)
- (cl-pushnew 'value eieio--known-slot-names))
-
-;;; Options
-
-(defcustom forge-database-file
- (expand-file-name "forge-database.sqlite" user-emacs-directory)
- "The file used to store the forge database."
- :package-version '(forge . "0.1.0")
- :group 'forge
- :type 'file)
-
-;;; Core
-
-(defclass forge-database (closql-database)
- ((name :initform "Forge")
- (object-class :initform 'forge-repository)
- (file :initform 'forge-database-file)
- (schemata :initform 'forge--db-table-schemata)
- (version :initform 13)))
-
-(defvar forge--override-connection-class nil)
-
-(defun forge-db (&optional livep)
- (closql-db 'forge-database livep forge--override-connection-class))
-
-(defun forge-sql (sql &rest args)
- (if (stringp sql)
- (emacsql (forge-db) (apply #'format sql args))
- (apply #'emacsql (forge-db) sql args)))
-
-(defun forge-sql-cdr (sql &rest args)
- (mapcar #'cdr (apply #'forge-sql sql args)))
-
-(defun forge-connect-database-once ()
- "Try to connect Forge database on first use of `magit-status' only."
- (remove-hook 'magit-status-mode-hook #'forge-connect-database-once)
- (forge-db))
-(add-hook 'magit-status-mode-hook #'forge-connect-database-once)
-
-(defun forge-enable-sql-logging ()
- "Enable logging Forge's SQL queries."
- (interactive)
- (let ((conn (oref (forge-db) connection)))
- (emacsql-enable-debugging conn)
- (switch-to-buffer-other-window (oref conn log-buffer))))
-
-;;; Schemata
-
-(defconst forge--db-table-schemata
- '((repository
- [(class :not-null)
- (id :not-null :primary-key)
- forge-id
- forge
- owner
- name
- apihost
- githost
- remote
- condition
- created
- updated
- pushed
- parent
- description
- homepage
- default-branch
- archived-p
- fork-p
- locked-p
- mirror-p
- private-p
- issues-p
- wiki-p
- stars
- watchers
- (assignees :default eieio-unbound)
- (forks :default eieio-unbound)
- (issues :default eieio-unbound)
- (labels :default eieio-unbound)
- (revnotes :default eieio-unbound)
- (pullreqs :default eieio-unbound)
- selective-p
- worktree
- (milestones :default eieio-unbound)
- issues-until
- pullreqs-until
- ])
-
- (assignee
- [(repository :not-null)
- (id :not-null :primary-key)
- login
- name
- forge-id] ; Needed for Gitlab.
- (:foreign-key
- [repository] :references repository [id]
- :on-delete :cascade))
-
- (fork
- [(parent :not-null)
- (id :not-null :primary-key)
- owner
- name]
- (:foreign-key
- [parent] :references repository [id]
- :on-delete :cascade))
-
- (issue
- [(class :not-null)
- (id :not-null :primary-key)
- repository
- number
- state
- author
- title
- created
- updated
- closed
- status
- locked-p
- milestone
- body
- (assignees :default eieio-unbound)
- (cards :default eieio-unbound)
- (edits :default eieio-unbound)
- (labels :default eieio-unbound)
- (participants :default eieio-unbound)
- (posts :default eieio-unbound)
- (reactions :default eieio-unbound)
- (timeline :default eieio-unbound)
- (marks :default eieio-unbound)
- note
- their-id
- slug
- saved-p]
- (:foreign-key
- [repository] :references repository [id]
- :on-delete :cascade))
-
- (issue-assignee
- [(issue :not-null)
- (id :not-null)]
- (:foreign-key
- [issue] :references issue [id]
- :on-delete :cascade))
-
- (issue-label
- [(issue :not-null)
- (id :not-null)]
- (:foreign-key
- [issue] :references issue [id]
- :on-delete :cascade)
- (:foreign-key
- [id] :references label [id]
- :on-delete :cascade))
-
- (issue-mark
- [(issue :not-null)
- (id :not-null)]
- (:foreign-key
- [issue] :references issue [id]
- :on-delete :cascade)
- (:foreign-key
- [id] :references mark [id]
- :on-delete :cascade))
-
- (issue-post
- [(class :not-null)
- (id :not-null :primary-key)
- issue
- number
- author
- created
- updated
- body
- (edits :default eieio-unbound)
- (reactions :default eieio-unbound)]
- (:foreign-key
- [issue] :references issue [id]
- :on-delete :cascade))
-
- (label
- [(repository :not-null)
- (id :not-null :primary-key)
- name
- color
- description]
- (:foreign-key
- [repository] :references repository [id]
- :on-delete :cascade))
-
- (mark
- [;; For now this is always nil because it seems more useful to
- ;; share marks between repositories. We cannot omit this slot
- ;; though because `closql--iref' expects `id' to be the second
- ;; slot.
- repository
- (id :not-null :primary-key)
- name
- face
- description])
-
- (milestone
- [(repository :not-null)
- (id :not-null :primary-key)
- number
- title
- created
- updated
- due
- closed
- description]
- (:foreign-key
- [repository] :references repository [id]
- :on-delete :cascade))
-
- (notification
- [(class :not-null)
- (id :not-null :primary-key)
- thread-id
- repository
- type
- topic
- url
- title
- reason
- last-read
- updated]
- (:foreign-key
- [repository] :references repository [id]
- :on-delete :cascade))
-
- (pullreq
- [(class :not-null)
- (id :not-null :primary-key)
- repository
- number
- state
- author
- title
- created
- updated
- closed
- merged
- status
- locked-p
- editable-p
- cross-repo-p
- base-ref
- base-repo
- head-ref
- head-user
- head-repo
- milestone
- body
- (assignees :default eieio-unbound)
- (cards :default eieio-unbound)
- (commits :default eieio-unbound)
- (edits :default eieio-unbound)
- (labels :default eieio-unbound)
- (participants :default eieio-unbound)
- (posts :default eieio-unbound)
- (reactions :default eieio-unbound)
- (review-requests :default eieio-unbound)
- (reviews :default eieio-unbound)
- (timeline :default eieio-unbound)
- (marks :default eieio-unbound)
- note
- base-rev
- head-rev
- draft-p
- their-id
- slug
- saved-p]
- (:foreign-key
- [repository] :references repository [id]
- :on-delete :cascade))
-
- (pullreq-assignee
- [(pullreq :not-null)
- (id :not-null)]
- (:foreign-key
- [pullreq] :references pullreq [id]
- :on-delete :cascade))
-
- (pullreq-label
- [(pullreq :not-null)
- (id :not-null)]
- (:foreign-key
- [pullreq] :references pullreq [id]
- :on-delete :cascade)
- (:foreign-key
- [id] :references label [id]
- :on-delete :cascade))
-
- (pullreq-mark
- [(pullreq :not-null)
- (id :not-null)]
- (:foreign-key
- [pullreq] :references pullreq [id]
- :on-delete :cascade)
- (:foreign-key
- [id] :references mark [id]
- :on-delete :cascade))
-
- (pullreq-post
- [(class :not-null)
- (id :not-null :primary-key)
- pullreq
- number
- author
- created
- updated
- body
- (edits :default eieio-unbound)
- (reactions :default eieio-unbound)]
- (:foreign-key
- [pullreq] :references pullreq [id]
- :on-delete :cascade))
-
- (pullreq-review-request
- [(pullreq :not-null)
- (id :not-null)]
- (:foreign-key
- [pullreq] :references pullreq [id]
- :on-delete :cascade))
-
- (revnote
- [(class :not-null)
- (id :not-null :primary-key)
- repository
- commit
- file
- line
- author
- body]
- (:foreign-key
- [repository] :references repository [id]
- :on-delete :cascade))))
-
-(cl-defmethod closql--db-update-schema ((db forge-database))
- (let ((code-version (oref-default 'forge-database version))
- (version (closql--db-get-version db)))
- (when (< version code-version)
- (forge--backup-database db))
- (closql-with-transaction db
- (when (= version 2)
- (message "Upgrading Forge database from version 2 to 3...")
- (emacsql db [:create-table pullreq-review-request $S1]
- (cdr (assq 'pullreq-review-request forge--db-table-schemata)))
- (closql--db-set-version db (setq version 3))
- (message "Upgrading Forge database from version 2 to 3...done"))
- (when (= version 3)
- (message "Upgrading Forge database from version 3 to 4...")
- (emacsql db [:drop-table notification])
- (pcase-dolist (`(,table . ,schema) forge--db-table-schemata)
- (when (memq table '(notification
- mark issue-mark pullreq-mark))
- (emacsql db [:create-table $i1 $S2] table schema)))
- (emacsql db [:alter-table issue :add-column marks :default $s1] 'eieio-unbound)
- (emacsql db [:alter-table pullreq :add-column marks :default $s1] 'eieio-unbound)
- (closql--db-set-version db (setq version 4))
- (message "Upgrading Forge database from version 3 to 4...done"))
- (when (= version 4)
- (message "Upgrading Forge database from version 4 to 5...")
- (emacsql db [:alter-table repository :add-column selective-p :default nil])
- (closql--db-set-version db (setq version 5))
- (message "Upgrading Forge database from version 4 to 5...done"))
- (when (= version 5)
- (message "Upgrading Forge database from version 5 to 6...")
- (emacsql db [:alter-table repository :add-column worktree :default nil])
- (closql--db-set-version db (setq version 6))
- (message "Upgrading Forge database from version 5 to 6...done"))
- (when (= version 6)
- (message "Upgrading Forge database from version 6 to 7...")
- (emacsql db [:alter-table issue :add-column note :default nil])
- (emacsql db [:alter-table pullreq :add-column note :default nil])
- (emacsql db [:create-table milestone $S1]
- (cdr (assq 'milestone forge--db-table-schemata)))
- (emacsql db [:alter-table repository :add-column milestones :default $s1]
- 'eieio-unbound)
- (pcase-dolist (`(,repo-id ,issue-id ,milestone)
- (emacsql db [:select [repository id milestone]
- :from issue
- :where (notnull milestone)]))
- (unless (stringp milestone)
- (oset (forge-get-issue issue-id) milestone
- (forge--object-id repo-id (cdar milestone)))))
- (pcase-dolist (`(,repo-id ,pullreq-id ,milestone)
- (emacsql db [:select [repository id milestone]
- :from pullreq
- :where (notnull milestone)]))
- (unless (stringp milestone)
- (oset (forge-get-pullreq pullreq-id) milestone
- (forge--object-id repo-id (cdar milestone)))))
- (closql--db-set-version db (setq version 7))
- (message "Upgrading Forge database from version 6 to 7...done"))
- (when (= version 7)
- (message "Upgrading Forge database from version 7 to 8...")
- (emacsql db [:alter-table pullreq :add-column base-rev :default nil])
- (emacsql db [:alter-table pullreq :add-column head-rev :default nil])
- (emacsql db [:alter-table pullreq :add-column draft-p :default nil])
- (closql--db-set-version db (setq version 8))
- (message "Upgrading Forge database from version 7 to 8...done"))
- (when (= version 8)
- (message "Upgrading Forge database from version 8 to 9...")
- (emacsql db [:alter-table pullreq :add-column their-id :default nil])
- (emacsql db [:alter-table issue :add-column their-id :default nil])
- (closql--db-set-version db (setq version 9))
- (message "Upgrading Forge database from version 8 to 9...done"))
- (when (= version 9)
- (message "Upgrading Forge database from version 9 to 10...")
- (emacsql db [:alter-table pullreq :add-column slug :default nil])
- (emacsql db [:alter-table issue :add-column slug :default nil])
- (pcase-dolist (`(,id ,number ,type)
- (emacsql
- db
- [:select [pullreq:id pullreq:number repository:class]
- :from pullreq
- :join repository
- :on (= pullreq:repository repository:id)]))
- (let ((gitlabp (memq type
- (append (closql-where-class-in
- 'forge-gitlab-repository--eieio-childp)
- nil))))
- (emacsql db [:update pullreq :set (= slug $s1) :where (= id $s2)]
- (format "%s%s" (if gitlabp "!" "#") number)
- id)))
- (pcase-dolist (`(,id ,number)
- (emacsql db [:select [id number] :from issue]))
- (emacsql db [:update issue :set (= slug $s1) :where (= id $s2)]
- (format "#%s" number)
- id))
- (closql--db-set-version db (setq version 10))
- (message "Upgrading Forge database from version 9 to 10...done"))
- (when (= version 10)
- (message "Upgrading Forge database from version 10 to 11...")
- (emacsql db [:drop-table notification])
- (emacsql db [:create-table notification $S1]
- (cdr (assq 'notification forge--db-table-schemata)))
- (emacsql db [:alter-table pullreq :rename-column unread-p :to status])
- (emacsql db [:alter-table issue :rename-column unread-p :to status])
- (emacsql db [:alter-table pullreq :add-column saved-p :default nil])
- (emacsql db [:alter-table issue :add-column saved-p :default nil])
- (closql--db-set-version db (setq version 11))
- (message "Upgrading Forge database from version 10 to 11...done"))
- (when (= version 11)
- (message "Upgrading Forge database from version 11 to 12...")
- (emacsql db [:drop-table notification])
- (emacsql db [:create-table notification $S1]
- (cdr (assq 'notification forge--db-table-schemata)))
- (dolist (id (emacsql db [:select id :from issue :where (= state 'closed)]))
- (emacsql db [:update issue :set (= state 'completed) :where (= id $s1)]
- id))
- (dolist (id (emacsql db [:select id :from issue :where (isnull status)]))
- (emacsql db [:update issue :set (= state 'done) :where (= id $s1)]
- id))
- (dolist (id (emacsql db [:select id :from pullreq :where (= state 'closed)]))
- (emacsql db [:update pullreq :set (= state 'rejected) :where (= id $s1)]
- id))
- (dolist (id (emacsql db [:select id :from pullreq :where (isnull status)]))
- (emacsql db [:update pullreq :set (= state 'done) :where (= id $s1)]
- id))
- (emacsql db [:alter-table repository :add-column issues-until :default nil])
- (emacsql db [:alter-table repository :add-column pullreqs-until :default nil])
- (closql--db-set-version db (setq version 12))
- (message "Upgrading Forge database from version 11 to 12...done"))
- (when (= version 12)
- (message "Upgrading Forge database from version 12 to 13...")
- (dolist (id (emacsql db [:select id :from repository
- :where (isnull issues-until)]))
- (emacsql
- db [:update repository :set (= issues-until $s1) :where (= id $s2)]
- (caar (forge-sql [:select [updated] :from issue
- :where (= repository $s1)
- :order-by [(desc updated)]
- :limit 1]
- id))
- id))
- (dolist (id (emacsql db [:select id :from repository
- :where (isnull pullreqs-until)]))
- (emacsql
- db [:update repository :set (= pullreqs-until $s1) :where (= id $s2)]
- (caar (forge-sql [:select [updated] :from pullreq
- :where (= repository $s1)
- :order-by [(desc updated)]
- :limit 1]
- id))
- id))
- (emacsql db [:alter-table repository :rename-column sparse-p :to condition])
- (pcase-dolist (`(,id ,not-tracked)
- (emacsql db [:select [id condition] :from repository]))
- (emacsql
- db [:update repository :set (= condition $s1) :where (= id $s2)]
- (if not-tracked :known :tracked)
- id))
- (closql--db-set-version db (setq version 13))
- (message "Upgrading Forge database from version 12 to 13...done"))
- )
- (cl-call-next-method)))
-
-(defun forge--backup-database (db)
- (let ((dst (concat (file-name-sans-extension forge-database-file)
- (format "-v%s" (caar (emacsql (oref db connection)
- [:pragma user-version])))
- (format-time-string "-%Y%m%d-%H%M")
- ".sqlite")))
- (message "Copying Forge database to %s..." dst)
- (copy-file forge-database-file dst)
- (message "Copying Forge database to %s...done" dst)))
-
-;;; _
-(provide 'forge-db)
-;;; forge-db.el ends here
+++ /dev/null
-;;; forge-gitea.el --- Gitea support -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2024 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This file is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this file. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'gtea)
-(require 'forge)
-
-;;; Class
-
-(defclass forge-gitea-repository (forge-unusedapi-repository)
- ((issues-url-format :initform "https://%h/%o/%n/issues")
- (issue-url-format :initform "https://%h/%o/%n/issues/%i")
- ;; The anchor for the issue itself is .../%i#issue-%i
- (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#issuecomment-%I")
- (pullreqs-url-format :initform "https://%h/%o/%n/pulls")
- (pullreq-url-format :initform "https://%h/%o/%n/pulls/%i")
- (pullreq-post-url-format :initform "https://%h/%o/%n/pulls/%i#issuecomment-%I")
- (commit-url-format :initform "https://%h/%o/%n/commit/%r")
- (branch-url-format :initform "https://%h/%o/%n/commits/branch/%r")
- (remote-url-format :initform "https://%h/%o/%n")
- (create-issue-url-format :initform "https://%h/%o/%n/issues/new")
- (create-pullreq-url-format :initform "https://%h/%o/%n/pulls") ; sic
- (pullreq-refspec :initform "+refs/pull/*/head:refs/pullreqs/*")))
-
-;;; _
-(provide 'forge-gitea)
-;;; forge-gitea.el ends here
+++ /dev/null
-;;; forge-github.el --- Github support -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2024 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This file is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this file. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ghub)
-
-(require 'forge)
-(require 'forge-issue)
-(require 'forge-pullreq)
-
-;;; Class
-
-(defclass forge-github-repository (forge-repository)
- ((issues-url-format :initform "https://%h/%o/%n/issues")
- (issue-url-format :initform "https://%h/%o/%n/issues/%i")
- (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#issuecomment-%I")
- (pullreqs-url-format :initform "https://%h/%o/%n/pulls")
- (pullreq-url-format :initform "https://%h/%o/%n/pull/%i")
- (pullreq-post-url-format :initform "https://%h/%o/%n/pull/%i#issuecomment-%I")
- (commit-url-format :initform "https://%h/%o/%n/commit/%r")
- (branch-url-format :initform "https://%h/%o/%n/commits/%r")
- (remote-url-format :initform "https://%h/%o/%n")
- (create-issue-url-format :initform "https://%h/%o/%n/issues/new")
- (create-pullreq-url-format :initform "https://%h/%o/%n/compare")
- (pullreq-refspec :initform "+refs/pull/*/head:refs/pullreqs/*")))
-
-;;; Query
-
-(defun forge--get-github-repository ()
- (forge-github-repository-p (forge-get-repository :stub?)))
-
-;;; Pull
-;;;; Repository
-
-(cl-defmethod forge--pull ((repo forge-github-repository)
- &optional callback since)
- (cl-assert (not (and since (forge-get-repository repo nil :tracked?))))
- (setq forge--mode-line-buffer (current-buffer))
- (forge--msg repo t nil "Pulling REPO")
- (let ((buf (current-buffer)))
- (ghub-fetch-repository
- (oref repo owner)
- (oref repo name)
- (lambda (data)
- (forge--msg repo t t "Pulling REPO")
- (forge--msg repo t nil "Storing REPO")
- (closql-with-transaction (forge-db)
- (let-alist data
- (forge--update-repository repo data)
- (forge--update-assignees repo .assignableUsers)
- (forge--update-forks repo .forks)
- (forge--update-labels repo .labels)
- (forge--update-milestones repo .milestones)
- (forge--update-issues repo .issues t)
- (forge--update-pullreqs repo .pullRequests t)
- (forge--update-revnotes repo .commitComments))
- (oset repo condition :tracked))
- (forge--msg repo t t "Storing REPO")
- (cond
- ((oref repo selective-p))
- (callback (funcall callback))
- ((forge--maybe-git-fetch repo buf))))
- `((issues-until . ,(or since (oref repo issues-until)))
- (pullRequests-until . ,(or since (oref repo pullreqs-until))))
- :host (oref repo apihost)
- :auth 'forge
- :sparse (oref repo selective-p))))
-
-(cl-defmethod forge--update-repository ((repo forge-github-repository) data)
- (let-alist data
- (oset repo created .createdAt)
- (oset repo updated .updatedAt)
- (oset repo pushed .pushedAt)
- (oset repo parent .parent.nameWithOwner)
- (oset repo description .description)
- (oset repo homepage (and (not (equal .homepageUrl "")) .homepageUrl))
- (oset repo default-branch .defaultBranchRef.name)
- (oset repo archived-p .isArchived)
- (oset repo fork-p .isFork)
- (oset repo locked-p .isLocked)
- (oset repo mirror-p .isMirror)
- (oset repo private-p .isPrivate)
- (oset repo issues-p .hasIssuesEnabled)
- (oset repo wiki-p .hasWikiEnabled)
- (oset repo stars .stargazers.totalCount)
- (oset repo watchers .watchers.totalCount)))
-
-(cl-defmethod forge--update-revnotes ((repo forge-github-repository) data)
- (closql-with-transaction (forge-db)
- (mapc (apply-partially #'forge--update-revnote repo) data)))
-
-(cl-defmethod forge--update-revnote ((repo forge-github-repository) data)
- (closql-with-transaction (forge-db)
- (let-alist data
- (closql-insert
- (forge-db)
- (forge-revnote
- :id (forge--object-id 'forge-revnote repo .id)
- :repository (oref repo id)
- :commit .commit.oid
- :file .path
- :line .position
- :author .author.login
- :body .body)
- t))))
-
-(cl-defmethod forge--update-assignees ((repo forge-github-repository) data)
- (oset repo assignees
- (with-slots (id) repo
- (mapcar (lambda (row)
- (let-alist row
- (list (forge--object-id id .id)
- .login
- .name
- .id)))
- (delete-dups data)))))
-
-(cl-defmethod forge--update-forks ((repo forge-github-repository) data)
- (oset repo forks
- (with-slots (id) repo
- (mapcar (lambda (row)
- (let-alist row
- (nconc (forge--repository-ids
- (eieio-object-class repo)
- (oref repo githost)
- .owner.login
- .name)
- (list .owner.login
- .name))))
- (delete-dups data)))))
-
-(cl-defmethod forge--update-labels ((repo forge-github-repository) data)
- (oset repo labels
- (with-slots (id) repo
- (mapcar (lambda (row)
- (let-alist row
- (list (forge--object-id id .id)
- .name
- (concat "#" (downcase .color))
- .description)))
- (delete-dups data)))))
-
-(cl-defmethod forge--update-milestones ((repo forge-github-repository) data)
- (oset repo milestones
- (with-slots (id) repo
- (mapcar (lambda (row)
- (let-alist row
- (list (forge--object-id id .id)
- .number
- .title
- .createdAt
- .updatedAt
- .dueOn
- .closedAt
- .description)))
- (delete-dups data)))))
-
-;;;; Topics
-
-(cl-defmethod forge--pull-topic ((repo forge-github-repository)
- (number number))
- (let ((id (oref repo id)))
- (forge--pull-topic
- repo
- (forge-issue :repository id :number number)
- :errorback (lambda (err _headers _status _req)
- (when (equal (cdr (assq 'type (cadr err))) "NOT_FOUND")
- (forge--pull-topic
- repo
- (forge-pullreq :repository id :number number)))))))
-
-(cl-defmethod forge--pull-topic ((repo forge-github-repository)
- (topic forge-issue)
- &key callback errorback)
- (let ((buffer (current-buffer)))
- (ghub-fetch-issue
- (oref repo owner)
- (oref repo name)
- (oref topic number)
- (lambda (data)
- (forge--update-issue repo data)
- (forge-refresh-buffer buffer)
- (when callback (funcall callback)))
- nil
- :host (oref repo apihost)
- :auth 'forge
- :errorback errorback)))
-
-(cl-defmethod forge--pull-topic ((repo forge-github-repository)
- (topic forge-pullreq)
- &key callback errorback)
- (let ((buffer (current-buffer)))
- (ghub-fetch-pullreq
- (oref repo owner)
- (oref repo name)
- (oref topic number)
- (lambda (data)
- (forge--update-pullreq repo data)
- (forge-refresh-buffer buffer)
- (when callback (funcall callback)))
- nil
- :host (oref repo apihost)
- :auth 'forge
- :errorback errorback)))
-
-(cl-defmethod forge--update-status ((repo forge-github-repository)
- topic data bump initial-pull)
- (let-alist data
- (let ((updated (or .updatedAt .createdAt))
- (current-status (oref topic status)))
- (cond ((not .isReadByViewer)
- (oset topic status 'unread))
- (initial-pull
- (oset topic status 'done))
- ((null current-status)
- (oset topic status 'pending))
- ((string> updated (oref topic updated))
- (oset topic status 'pending)))
- (oset topic updated updated)
- (when bump
- (let* ((slot (if (forge-issue-p topic) 'issues-until 'pullreqs-until))
- (until (eieio-oref repo slot)))
- (when (or (not until) (string> updated until))
- (eieio-oset repo slot updated)))))))
-
-;;;; Issues
-
-(cl-defmethod forge--update-issues ((repo forge-github-repository) data
- &optional bump)
- (closql-with-transaction (forge-db)
- (let ((initial-pull (not (oref repo issues-until))))
- (mapc (lambda (e) (forge--update-issue repo e bump initial-pull)) data))))
-
-(cl-defmethod forge--update-issue ((repo forge-github-repository) data
- &optional bump initial-pull)
- (let (issue-id issue)
- (let-alist data
- (closql-with-transaction (forge-db)
- (setq issue-id (forge--object-id 'forge-issue repo .number))
- (setq issue (or (forge-get-issue repo .number)
- (closql-insert
- (forge-db)
- (forge-issue :id issue-id
- :repository (oref repo id)
- :number .number))))
- (oset issue their-id .id)
- (oset issue slug (format "#%s" .number))
- (oset issue state
- (pcase-exhaustive (list .stateReason .state)
- (`("COMPLETED" ,_) 'completed)
- (`("NOT_PLANNED" ,_) 'unplanned)
- (`(,_ "CLOSED") 'completed)
- (`(,_ "OPEN") 'open)))
- (oset issue author .author.login)
- (oset issue title .title)
- (oset issue created .createdAt)
- (oset issue closed .closedAt)
- (oset issue locked-p .locked)
- (oset issue milestone (and .milestone.id
- (forge--object-id (oref repo id)
- .milestone.id)))
- (oset issue body (forge--sanitize-string .body))
- (dolist (c .comments)
- (let-alist c
- (closql-insert
- (forge-db)
- (forge-issue-post
- :id (forge--object-id issue-id .databaseId)
- :issue issue-id
- :number .databaseId
- :author .author.login
- :created .createdAt
- :updated .updatedAt
- :body (forge--sanitize-string .body))
- t)))
- (forge--update-status repo issue data bump initial-pull))
- (ignore-errors
- (forge--set-id-slot repo issue 'assignees .assignees))
- (ignore-errors
- (unless (magit-get-boolean "forge.kludge-for-issue-294")
- (forge--set-id-slot repo issue 'labels .labels))))
- issue))
-
-;;;; Pullreqs
-
-(cl-defmethod forge--update-pullreqs ((repo forge-github-repository) data
- &optional bump)
- (closql-with-transaction (forge-db)
- (let ((initial-pull (not (oref repo pullreqs-until))))
- (mapc (lambda (e) (forge--update-pullreq repo e bump initial-pull)) data))))
-
-(cl-defmethod forge--update-pullreq ((repo forge-github-repository) data
- &optional bump initial-pull)
- (let (pullreq-id pullreq)
- (let-alist data
- (closql-with-transaction (forge-db)
- (setq pullreq-id (forge--object-id 'forge-pullreq repo .number))
- (setq pullreq (or (forge-get-pullreq repo .number)
- (closql-insert
- (forge-db)
- (forge-pullreq :id pullreq-id
- :repository (oref repo id)
- :number .number))))
- (oset pullreq their-id .id)
- (oset pullreq slug (format "#%s" .number))
- (oset pullreq state (pcase-exhaustive .state
- ("MERGED" 'merged)
- ("CLOSED" 'rejected)
- ("OPEN" 'open)))
- (oset pullreq author .author.login)
- (oset pullreq title .title)
- (oset pullreq created .createdAt)
- (oset pullreq closed .closedAt)
- (oset pullreq merged .mergedAt)
- (oset pullreq draft-p .isDraft)
- (oset pullreq locked-p .locked)
- (oset pullreq editable-p .maintainerCanModify)
- (oset pullreq cross-repo-p .isCrossRepository)
- (oset pullreq base-ref .baseRef.name)
- (oset pullreq base-rev .baseRefOid)
- (oset pullreq base-repo .baseRef.repository.nameWithOwner)
- (oset pullreq head-ref .headRef.name)
- (oset pullreq head-rev .headRefOid)
- (oset pullreq head-user .headRef.repository.owner.login)
- (oset pullreq head-repo .headRef.repository.nameWithOwner)
- (oset pullreq milestone (and .milestone.id
- (forge--object-id (oref repo id)
- .milestone.id)))
- (oset pullreq body (forge--sanitize-string .body))
- (dolist (p .comments)
- (let-alist p
- (closql-insert
- (forge-db)
- (forge-pullreq-post
- :id (forge--object-id pullreq-id .databaseId)
- :pullreq pullreq-id
- :number .databaseId
- :author .author.login
- :created .createdAt
- :updated .updatedAt
- :body (forge--sanitize-string .body))
- t)))
- (forge--update-status repo pullreq data bump initial-pull))
- (ignore-errors
- (forge--set-id-slot repo pullreq 'assignees .assignees))
- (ignore-errors
- (forge--set-id-slot repo pullreq 'review-requests
- (--map (cdr (cadr (car it)))
- .reviewRequests)))
- (ignore-errors
- (unless (magit-get-boolean "forge.kludge-for-issue-294")
- (forge--set-id-slot repo pullreq 'labels .labels))))
- pullreq))
-
-;;;; Notifications
-
-(cl-defmethod forge--pull-notifications
- ((_class (subclass forge-github-repository)) githost &optional callback)
- ;; The GraphQL API doesn't support notifications and support in the
- ;; REST API is abysmal -- forcing us to perform a major rain dance.
- (let ((spec (forge--get-forge-host githost t)))
- (forge--msg nil t nil "Pulling notifications")
- (pcase-let*
- ((`(,_ ,apihost ,forge ,_) spec)
- (since (forge--ghub-notifications-since forge))
- (notifs
- (seq-keep (lambda (data)
- ;; Github returns notifications for repositories the
- ;; user no longer has access to. Trying to retrieve
- ;; information for such repositories leads to errors,
- ;; which we suppress. See #164.
- (with-demoted-errors "forge--pull-notifications: %S"
- (forge--ghub-massage-notification data githost)))
- (forge--ghub-get nil "/notifications"
- `((all . t) ,@(and since `((since . ,since))))
- :host apihost :unpaginate t)))
- ;; Split into multiple requests to reduce risk of timeouts.
- (groups (-partition-all 50 notifs))
- (pages (length groups))
- (page 0)
- (topics nil))
- (cl-labels
- ((cb (&optional data _headers _status _req)
- (when data
- (setq topics (nconc topics (cdr data))))
- (if groups
- (let* ((query (seq-keep #'caddr (pop groups)))
- (tries 3)
- (errorback nil)
- (vacuum (lambda ()
- (ghub--graphql-vacuum
- (cons 'query query) nil #'cb nil
- :auth 'forge :host apihost
- :errorback errorback))))
- ;; Github also returns notifications for issues
- ;; belonging to repositories for which issues
- ;; have been disabled. Drop them and try again.
- (setq errorback
- (lambda (errors _headers _status _req)
- (if (zerop tries)
- (ghub--signal-error errors)
- (cl-decf tries)
- (if-let ((notfound
- (seq-keep
- (lambda (err)
- (and (equal (cdr (assq 'type err))
- "NOT_FOUND")
- (cadr (assq 'path err))
- (intern (cadr (assq 'path err)))))
- (cdr errors))))
- (progn
- (setq query (cl-delete-if
- (lambda (e) (memq e notfound))
- query :key #'caar))
- (funcall vacuum))
- (ghub--signal-error errors)))))
- (cl-incf page)
- (forge--msg nil t nil
- "Pulling notifications (page %s/%s)" page pages)
- (funcall vacuum))
- (forge--msg nil t t "Pulling notifications")
- (forge--msg nil t nil "Storing notifications")
- (forge--ghub-update-notifications notifs topics (not since))
- (forge--msg nil t t "Storing notifications")
- (when callback
- (funcall callback)))))
- (cb)))))
-
-(defun forge--ghub-notifications-since (forge)
- (caar (forge-sql [:select :distinct [notification:updated]
- :from [notification repository]
- :where (and (= repository:forge $s1)
- (= repository:id notification:repository))
- :order-by [(desc notification:updated)]]
- forge)))
-
-(defun forge--ghub-massage-notification (data githost)
- (let-alist data
- (let* ((type (intern (downcase .subject.type)))
- (type (if (eq type 'pullrequest) 'pullreq type)))
- (and (memq type '(pullreq issue))
- (let* ((number (and (string-match "[0-9]*\\'" .subject.url)
- (string-to-number (match-string 0 .subject.url))))
- (repo (forge-get-repository
- (list githost
- .repository.owner.login
- .repository.name)
- nil :insert!))
- (repoid (oref repo id))
- (owner (oref repo owner))
- (name (oref repo name))
- (id (forge--object-id repoid (string-to-number .id)))
- (alias (intern (concat "_" (string-replace "=" "_" id)))))
- (list alias id
- `((,alias repository)
- [(name ,name)
- (owner ,owner)]
- ,@(cddr
- (caddr
- (ghub--graphql-prepare-query
- ghub-fetch-repository
- (if (eq type 'issue)
- `(repository issues (issue . ,number))
- `(repository pullRequest (pullRequest . ,number)))
- ))))
- repo type data))))))
-
-(defun forge--ghub-update-notifications (notifs topics initial-pull)
- (closql-with-transaction (forge-db)
- (pcase-dolist (`(,alias ,id ,_ ,repo ,type ,data) notifs)
- (let-alist data
- (and-let*
- ((topic-data (cdr (cadr (assq alias topics))))
- (topic (funcall (if (eq type 'issue)
- #'forge--update-issue
- #'forge--update-pullreq)
- repo topic-data nil initial-pull))
- (notif (or (forge-get-notification id)
- (closql-insert (forge-db)
- (forge-notification
- :id id
- :thread-id .id
- :repository (oref repo id)
- :type type
- :topic (oref topic id)
- :url .subject.url)))))
- (oset notif title .subject.title)
- (oset notif reason (intern (downcase .reason)))
- (oset notif last-read .last_read_at)
- (oset notif updated .updated_at))))))
-
-;;;; Miscellaneous
-
-(cl-defmethod forge--add-user-repos
- ((class (subclass forge-github-repository)) host user)
- (forge--fetch-user-repos
- class (forge--as-apihost host) user
- (apply-partially #'forge--batch-add-callback (forge--as-githost host) user)))
-
-(cl-defmethod forge--add-organization-repos
- ((class (subclass forge-github-repository)) host org)
- (forge--fetch-organization-repos
- class (forge--as-apihost host) org
- (apply-partially #'forge--batch-add-callback (forge--as-githost host) org)))
-
-(cl-defmethod forge--fetch-user-repos
- ((_ (subclass forge-github-repository)) host user callback)
- (ghub--graphql-vacuum
- '(query (user
- [(login $login String!)]
- (repositories
- [(:edges t)
- (ownerAffiliations . (OWNER))]
- name)))
- `((login . ,user))
- (lambda (d)
- (funcall callback
- (--map (alist-get 'name it)
- (let-alist d .user.repositories))))
- nil :auth 'forge :host host))
-
-(cl-defmethod forge--fetch-organization-repos
- ((_ (subclass forge-github-repository)) host org callback)
- (ghub--graphql-vacuum
- '(query (organization
- [(login $login String!)]
- (repositories [(:edges t)] name)))
- `((login . ,org))
- (lambda (d)
- (funcall callback
- (--map (alist-get 'name it)
- (let-alist d .organization.repositories))))
- nil :auth 'forge :host host))
-
-(defun forge--batch-add-callback (host owner names)
- (let ((repos (mapcan (lambda (name)
- (let ((repo (forge-get-repository
- (list host owner name)
- nil :insert!)))
- (and (not (forge-get-repository repo nil :tracked?))
- (list repo))))
- names))
- (cb nil))
- (setq cb (lambda ()
- (when-let ((repo (pop repos)))
- (forge--pull repo cb))))
- (funcall cb)))
-
-;;; Mutations
-
-(cl-defmethod forge--submit-create-issue ((_ forge-github-repository) repo)
- (let-alist (forge--topic-parse-buffer)
- (forge--ghub-post repo "/repos/:owner/:repo/issues"
- `((title . , .title)
- (body . , .body)
- ,@(and .labels (list (cons 'labels .labels)))
- ,@(and .assignees (list (cons 'assignees .assignees))))
- :callback (forge--post-submit-callback)
- :errorback (forge--post-submit-errorback))))
-
-(cl-defmethod forge--create-pullreq-from-issue ((repo forge-github-repository)
- (issue forge-issue)
- source target)
- (pcase-let* ((`(,base-remote . ,base-branch)
- (magit-split-branch-name target))
- (`(,head-remote . ,head-branch)
- (magit-split-branch-name source))
- (head-repo (forge-get-repository :stub head-remote)))
- (forge--ghub-post repo "/repos/:owner/:repo/pulls"
- `((issue . ,(oref issue number))
- (base . ,base-branch)
- (head . ,(if (equal head-remote base-remote)
- head-branch
- (concat (oref head-repo owner) ":"
- head-branch)))
- (maintainer_can_modify . t))
- :callback (lambda (&rest _)
- (closql-delete issue)
- (forge-pull))
- :errorback (lambda (&rest _) (forge-pull)))))
-
-(cl-defmethod forge--submit-create-pullreq ((_ forge-github-repository) repo)
- (let-alist (forge--topic-parse-buffer)
- (when (and .yaml (local-variable-p 'forge-buffer-draft-p))
- (user-error "Cannot use yaml frontmatter and set `%s' at the same time"
- 'forge-buffer-draft-p))
- (pcase-let* ((`(,base-remote . ,base-branch)
- (magit-split-branch-name forge--buffer-base-branch))
- (`(,head-remote . ,head-branch)
- (magit-split-branch-name forge--buffer-head-branch))
- (head-repo (forge-get-repository :stub head-remote))
- (url-mime-accept-string
- ;; Support draft pull-requests.
- "application/vnd.github.shadow-cat-preview+json"))
- (forge--ghub-post repo "/repos/:owner/:repo/pulls"
- `((title . , .title)
- (body . , .body)
- (base . ,base-branch)
- (head . ,(if (equal head-remote base-remote)
- head-branch
- (concat (oref head-repo owner) ":"
- head-branch)))
- (draft . ,(if (local-variable-p 'forge-buffer-draft-p)
- forge-buffer-draft-p
- .draft))
- (maintainer_can_modify . t))
- :callback (forge--post-submit-callback)
- :errorback (forge--post-submit-errorback)))))
-
-(cl-defmethod forge--submit-create-post ((_ forge-github-repository) topic)
- (forge--ghub-post topic "/repos/:owner/:repo/issues/:number/comments"
- `((body . ,(string-trim (buffer-string))))
- :callback (forge--post-submit-callback)
- :errorback (forge--post-submit-errorback)))
-
-(cl-defmethod forge--submit-edit-post ((_ forge-github-repository) post)
- (forge--ghub-patch post
- (cl-typecase post
- (forge-pullreq "/repos/:owner/:repo/pulls/:number")
- (forge-issue "/repos/:owner/:repo/issues/:number")
- (forge-post "/repos/:owner/:repo/issues/comments/:number"))
- (if (cl-typep post 'forge-topic)
- (let-alist (forge--topic-parse-buffer)
- `((title . , .title)
- (body . , .body)))
- `((body . ,(string-trim (buffer-string)))))
- :callback (forge--post-submit-callback)
- :errorback (forge--post-submit-errorback)))
-
-(cl-defmethod forge--set-topic-title
- ((_repo forge-github-repository) topic title)
- (forge--ghub-patch topic
- "/repos/:owner/:repo/issues/:number"
- `((title . ,title))
- :callback (forge--set-field-callback topic)))
-
-(cl-defmethod forge--set-topic-state
- ((_repo forge-github-repository) topic state)
- (forge--ghub-patch topic
- "/repos/:owner/:repo/issues/:number"
- (pcase-exhaustive state
- ;; Merging isn't done through here.
- ('completed '((state . "closed") (state_reason . "completed")))
- ('unplanned '((state . "closed") (state_reason . "not_planned")))
- ('rejected '((state . "closed")))
- ('open '((state . "open"))))
- :callback (forge--set-field-callback topic)))
-
-(cl-defmethod forge--set-topic-draft
- ((_repo forge-github-repository) topic value)
- (let ((buffer (current-buffer)))
- (ghub-graphql
- `(mutation (,(if value
- 'convertPullRequestToDraft
- 'markPullRequestReadyForReview)
- [(input $input ,(if value
- 'ConvertPullRequestToDraftInput!
- 'MarkPullRequestReadyForReviewInput!))]
- (pullRequest isDraft)))
- `((input (pullRequestId . ,(oref topic their-id))))
- :host (oref (forge-get-repository topic) apihost)
- :auth 'forge
- :callback (lambda (data &rest _)
- (if (assq 'error data)
- (ghub--graphql-pp-response data)
- (oset topic draft-p value)
- (forge-refresh-buffer buffer))))))
-
-(cl-defmethod forge--set-topic-milestone
- ((repo forge-github-repository) topic milestone)
- (forge--ghub-patch topic
- "/repos/:owner/:repo/issues/:number"
- (if milestone
- `((milestone . ,(caar (forge-sql [:select [number]
- :from milestone
- :where (and (= repository $s1)
- (= title $s2))]
- (oref repo id)
- milestone))))
- `((milestone . :null)))
- :callback (forge--set-field-callback topic)))
-
-(cl-defmethod forge--set-topic-labels
- ((_repo forge-github-repository) topic labels)
- (funcall (if labels #'forge--ghub-put #'forge--ghub-delete)
- topic "/repos/:owner/:repo/issues/:number/labels" nil
- :payload labels
- :callback (forge--set-field-callback topic)))
-
-(cl-defmethod forge--set-topic-assignees
- ((_repo forge-github-repository) topic assignees)
- (let ((value (mapcar #'cadr (oref topic assignees))))
- ;; FIXME Only refresh once.
- (when-let ((add (cl-set-difference assignees value :test #'equal)))
- (forge--ghub-post topic "/repos/:owner/:repo/issues/:number/assignees"
- `((assignees . ,add))
- :callback (forge--set-field-callback topic)))
- (when-let ((remove (cl-set-difference value assignees :test #'equal)))
- (forge--ghub-delete topic "/repos/:owner/:repo/issues/:number/assignees"
- `((assignees . ,remove))
- :callback (forge--set-field-callback topic)))))
-
-(cl-defmethod forge--set-topic-review-requests
- ((_repo forge-github-repository) topic reviewers)
- (let ((value (mapcar #'cadr (oref topic review-requests))))
- ;; FIXME Only refresh once.
- (when-let ((add (cl-set-difference reviewers value :test #'equal)))
- (forge--ghub-post topic
- "/repos/:owner/:repo/pulls/:number/requested_reviewers"
- `((reviewers . ,add))
- :callback (forge--set-field-callback topic)))
- (when-let ((remove (cl-set-difference value reviewers :test #'equal)))
- (forge--ghub-delete topic
- "/repos/:owner/:repo/pulls/:number/requested_reviewers"
- `((reviewers . ,remove))
- :callback (forge--set-field-callback topic)))))
-
-(cl-defmethod forge--delete-comment
- ((_repo forge-github-repository) post)
- (forge--ghub-delete post "/repos/:owner/:repo/issues/comments/:number")
- (closql-delete post)
- (forge-refresh-buffer))
-
-(cl-defmethod forge--topic-template-files ((repo forge-github-repository)
- (_ (subclass forge-issue)))
- (and-let* ((files (magit-revision-files (oref repo default-branch))))
- (let ((case-fold-search t))
- (if-let ((file (--first (string-match-p "\
-\\`\\(\\|docs/\\|\\.github/\\)issue_template\\(\\.[a-zA-Z0-9]+\\)?\\'" it)
- files)))
- (list file)
- (setq files
- (--filter (string-match-p "\\`\\.github/ISSUE_TEMPLATE/[^/]*" it)
- files))
- (if-let ((conf (cl-find-if
- (lambda (f)
- (equal (file-name-nondirectory f) "config.yml"))
- files)))
- (nconc (delete conf files)
- (list conf))
- files)))))
-
-(cl-defmethod forge--topic-template-files ((repo forge-github-repository)
- (_ (subclass forge-pullreq)))
- (and-let* ((files (magit-revision-files (oref repo default-branch))))
- (let ((case-fold-search t))
- (if-let ((file (--first (string-match-p "\
-\\`\\(\\|docs/\\|\\.github/\\)pull_request_template\\(\\.[a-zA-Z0-9]+\\)?\\'" it)
- files)))
- (list file)
- ;; Unlike for issues, the web interface does not support
- ;; multiple pull-request templates. The API does though,
- ;; but due to this limitation I doubt many people use them,
- ;; so Forge doesn't support them either.
- ))))
-
-(cl-defmethod forge--set-default-branch ((repo forge-github-repository)
- newname oldname)
- (forge--ghub-post repo
- (format "/repos/:owner/:name/branches/%s/rename" oldname)
- `((new_name . ,newname)))
- (message "Waiting 5 seconds for GitHub to complete rename...")
- (sleep-for 5)
- (message "Waiting 5 seconds for GitHub to complete rename...done")
- (magit-call-git "fetch" "--prune" (oref repo remote))
- (magit--set-default-branch newname oldname))
-
-(cl-defmethod forge--fork-repository ((repo forge-github-repository) fork)
- (with-slots (owner name) repo
- (forge--ghub-post repo
- (format "/repos/%s/%s/forks" owner name)
- (and (not (equal fork (ghub--username (ghub--host nil))))
- `((organization . ,fork))))
- (ghub-wait (format "/repos/%s/%s" fork name) nil :auth 'forge)))
-
-(cl-defmethod forge--merge-pullreq ((_repo forge-github-repository)
- topic hash method)
- (forge--ghub-put topic
- "/repos/:owner/:repo/pulls/:number/merge"
- `((merge_method . ,(symbol-name method))
- ,@(and hash `((sha . ,hash))))))
-
-;;; Wrappers
-
-(cl-defun forge--ghub-get (obj resource
- &optional params
- &key query payload headers
- silent unpaginate noerror reader
- host
- callback errorback)
- (declare (indent defun))
- (ghub-get (if obj (forge--format-resource obj resource) resource)
- params
- :host (or host (oref (forge-get-repository obj) apihost))
- :auth 'forge
- :query query :payload payload :headers headers
- :silent silent :unpaginate unpaginate
- :noerror noerror :reader reader
- :callback callback :errorback errorback))
-
-(cl-defun forge--ghub-put (obj resource
- &optional params
- &key query payload headers
- silent unpaginate noerror reader
- host
- callback errorback)
- (declare (indent defun))
- (ghub-put (if obj (forge--format-resource obj resource) resource)
- params
- :host (or host (oref (forge-get-repository obj) apihost))
- :auth 'forge
- :query query :payload payload :headers headers
- :silent silent :unpaginate unpaginate
- :noerror noerror :reader reader
- :callback callback :errorback errorback))
-
-(cl-defun forge--ghub-post (obj resource
- &optional params
- &key query payload headers
- silent unpaginate noerror reader
- host callback errorback)
- (declare (indent defun))
- (ghub-post (forge--format-resource obj resource)
- params
- :host (or host (oref (forge-get-repository obj) apihost))
- :auth 'forge
- :query query :payload payload :headers headers
- :silent silent :unpaginate unpaginate
- :noerror noerror :reader reader
- :callback callback :errorback errorback))
-
-(cl-defun forge--ghub-patch (obj resource
- &optional params
- &key query payload headers
- silent unpaginate noerror reader
- host callback errorback)
- (declare (indent defun))
- (ghub-patch (forge--format-resource obj resource)
- params
- :host (or host (oref (forge-get-repository obj) apihost))
- :auth 'forge
- :query query :payload payload :headers headers
- :silent silent :unpaginate unpaginate
- :noerror noerror :reader reader
- :callback callback :errorback errorback))
-
-(cl-defun forge--ghub-delete (obj resource
- &optional params
- &key query payload headers
- silent unpaginate noerror reader
- host callback errorback)
- (declare (indent defun))
- (ghub-delete (forge--format-resource obj resource)
- params
- :host (or host (oref (forge-get-repository obj) apihost))
- :auth 'forge
- :query query :payload payload :headers headers
- :silent silent :unpaginate unpaginate
- :noerror noerror :reader reader
- :callback callback :errorback errorback))
-
-;;; _
-(provide 'forge-github)
-;;; forge-github.el ends here
+++ /dev/null
-;;; forge-gitlab.el --- Gitlab support -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2024 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This file is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this file. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'glab)
-
-(require 'forge)
-(require 'forge-issue)
-(require 'forge-pullreq)
-
-;;; Class
-
-(defclass forge-gitlab-repository (forge-repository)
- ((issues-url-format :initform "https://%h/%o/%n/issues")
- (issue-url-format :initform "https://%h/%o/%n/issues/%i")
- (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#note_%I")
- (pullreqs-url-format :initform "https://%h/%o/%n/merge_requests")
- (pullreq-url-format :initform "https://%h/%o/%n/merge_requests/%i")
- (pullreq-post-url-format :initform "https://%h/%o/%n/merge_requests/%i#note_%I")
- (commit-url-format :initform "https://%h/%o/%n/commit/%r")
- (branch-url-format :initform "https://%h/%o/%n/commits/%r")
- (remote-url-format :initform "https://%h/%o/%n")
- (create-issue-url-format :initform "https://%h/%o/%n/issues/new")
- (create-pullreq-url-format :initform "https://%h/%o/%n/merge_requests/new")
- (pullreq-refspec :initform "+refs/merge-requests/*/head:refs/pullreqs/*")))
-
-;;; Pull
-;;;; Repository
-
-(cl-defmethod forge--pull ((repo forge-gitlab-repository)
- &optional callback since)
- (cl-assert (not (and since (forge-get-repository repo nil :tracked?))))
- (setq forge--mode-line-buffer (current-buffer))
- (forge--msg repo t nil "Pulling REPO")
- (let ((cb (let ((buf (current-buffer))
- (val nil))
- (lambda (cb &optional v)
- (when v (if val (push v val) (setq val v)))
- (let-alist val
- (cond
- ((not val)
- (forge--fetch-repository repo cb))
- ((not (assq 'assignees val))
- (forge--fetch-assignees repo cb))
- ((not (assq 'forks val))
- (forge--fetch-forks repo cb))
- ((not (assq 'labels val))
- (forge--fetch-labels repo cb))
- ((and .issues_enabled
- (not (assq 'issues val)))
- (forge--fetch-issues repo cb since))
- ((and .merge_requests_enabled
- (not (assq 'pullreqs val)))
- (forge--fetch-pullreqs repo cb since))
- (t
- (forge--msg repo t t "Pulling REPO")
- (forge--msg repo t nil "Storing REPO")
- (closql-with-transaction (forge-db)
- (forge--update-repository repo val)
- (forge--update-assignees repo .assignees)
- (forge--update-labels repo .labels)
- (dolist (v .issues) (forge--update-issue repo v))
- (dolist (v .pullreqs) (forge--update-pullreq repo v))
- (oset repo condition :tracked))
- (forge--msg repo t t "Storing REPO")
- (cond
- ((oref repo selective-p))
- (callback (funcall callback))
- ((forge--maybe-git-fetch repo buf))))))))))
- (funcall cb cb)))
-
-(cl-defmethod forge--fetch-repository ((repo forge-gitlab-repository) callback)
- (forge--glab-get repo "/projects/:project" nil
- :callback (lambda (value _headers _status _req)
- (cond ((oref repo selective-p)
- (setq value (append '((assignees) (forks) (labels)
- (issues) (pullreqs))
- value)))
- ((magit-get-boolean "forge.omitExpensive")
- (setq value (append '((assignees) (forks) (labels))
- value))))
- (funcall callback callback value))))
-
-(cl-defmethod forge--update-repository ((repo forge-gitlab-repository) data)
- (let-alist data
- (oset repo created .created_at)
- (oset repo updated .last_activity_at)
- (oset repo pushed nil)
- (oset repo parent .forked_from_project.path_with_namespace)
- (oset repo description .description)
- (oset repo homepage nil)
- (oset repo default-branch .default_branch)
- (oset repo archived-p .archived)
- (oset repo fork-p (and .forked_from_project.path_with_namespace t))
- (oset repo locked-p nil)
- (oset repo mirror-p .mirror)
- (oset repo private-p (equal .visibility "private"))
- (oset repo issues-p .issues_enabled)
- (oset repo wiki-p .wiki_enabled)
- (oset repo stars .star_count)
- (oset repo watchers .star_count)))
-
-;;;; Topics
-
-(cl-defmethod forge--pull-topic ((repo forge-gitlab-repository) _topic
- &key callback _errorback)
- (forge--pull repo callback)) ; TODO Pull only the one topic.
-
-;;;; Issues
-
-(cl-defmethod forge--fetch-issues ((repo forge-gitlab-repository) callback since)
- (let ((cb (let (val cur cnt pos)
- (lambda (cb &optional v)
- (cond
- ((not pos)
- (if (setq cur (setq val v))
- (progn
- (setq pos 1)
- (setq cnt (length val))
- (forge--msg nil nil nil "Pulling issue %s/%s" pos cnt)
- (forge--fetch-issue-posts repo cur cb))
- (forge--msg repo t t "Pulling REPO issues")
- (funcall callback callback (cons 'issues val))))
- (t
- (if (setq cur (cdr cur))
- (progn
- (cl-incf pos)
- (forge--msg nil nil nil "Pulling issue %s/%s" pos cnt)
- (forge--fetch-issue-posts repo cur cb))
- (forge--msg repo t t "Pulling REPO issues")
- (funcall callback callback (cons 'issues val)))))))))
- (forge--msg repo t nil "Pulling REPO issues")
- (forge--glab-get repo "/projects/:project/issues"
- `((per_page . 100)
- (order_by . "updated_at")
- ,@(and-let* ((after (or since (oref repo issues-until))))
- `((updated_after . ,after))))
- :unpaginate t
- :callback (lambda (value _headers _status _req)
- (funcall cb cb value)))))
-
-(cl-defmethod forge--fetch-issue-posts ((repo forge-gitlab-repository) cur cb)
- (let-alist (car cur)
- (forge--glab-get repo
- (format "/projects/%s/issues/%s/notes" .project_id .iid)
- '((per_page . 100))
- :unpaginate t
- :callback (lambda (value _headers _status _req)
- (setf (alist-get 'notes (car cur)) value)
- (funcall cb cb)))))
-
-(cl-defmethod forge--update-issue ((repo forge-gitlab-repository) data)
- (closql-with-transaction (forge-db)
- (let-alist data
- (let* ((issue-id (forge--object-id 'forge-issue repo .iid))
- (issue
- (forge-issue
- :id issue-id
- :their-id .iid
- :number .iid
- :slug (format "#%s" .iid)
- :repository (oref repo id)
- ;; Gitlab doesn't make a distinction between completed
- ;; and unplanned issues. Treat them all as completed.
- :state (pcase-exhaustive .state
- ("closed" 'completed)
- ("opened" 'open))
- :author .author.username
- :title .title
- :created .created_at
- :updated .updated_at
- ;; `.closed_at' may be nil even though the issues is
- ;; closed. In such cases use 1, so that this slot
- ;; at least can serve as a boolean.
- :closed (or .closed_at (and (equal .state "closed") 1))
- :locked-p .discussion_locked
- :milestone .milestone.iid
- :body (forge--sanitize-string .description))))
- (closql-insert (forge-db) issue t)
- (unless (magit-get-boolean "forge.omitExpensive")
- (forge--set-id-slot repo issue 'assignees .assignees)
- (forge--set-id-slot repo issue 'labels .labels))
- (dolist (c .notes)
- (let-alist c
- (let ((post
- (forge-issue-post
- :id (forge--object-id issue-id .id)
- :issue issue-id
- :number .id
- :author .author.username
- :created .created_at
- :updated .updated_at
- :body (forge--sanitize-string .body))))
- (closql-insert (forge-db) post t))))
- (let ((until (oref repo issues-until)))
- (when (or (not until) (string> .updated_at until))
- (oset repo issues-until .updated_at)))
- issue))))
-
-;;;; Pullreqs
-
-(cl-defmethod forge--fetch-pullreqs ((repo forge-gitlab-repository) callback since)
- (let ((cb (let (val cur cnt pos)
- (lambda (cb &optional v)
- (cond
- ((not pos)
- (if (setq cur (setq val v))
- (progn
- (setq pos 1)
- (setq cnt (length val))
- (forge--msg nil nil nil "Pulling pullreq %s/%s" pos cnt)
- (forge--fetch-pullreq-posts repo cur cb))
- (forge--msg repo t t "Pulling REPO pullreqs")
- (funcall callback callback (cons 'pullreqs val))))
- ((not (assq 'source_project (car cur)))
- (forge--fetch-pullreq-source-repo repo cur cb))
- ((not (assq 'target_project (car cur)))
- (forge--fetch-pullreq-target-repo repo cur cb))
- (t
- (if (setq cur (cdr cur))
- (progn
- (cl-incf pos)
- (forge--msg nil nil nil "Pulling pullreq %s/%s" pos cnt)
- (forge--fetch-pullreq-posts repo cur cb))
- (forge--msg repo t t "Pulling REPO pullreqs")
- (funcall callback callback (cons 'pullreqs val)))))))))
- (forge--msg repo t nil "Pulling REPO pullreqs")
- (forge--glab-get repo "/projects/:project/merge_requests"
- `((per_page . 100)
- (order_by . "updated_at")
- ,@(and-let* ((after (or since (oref repo pullreqs-until))))
- `((updated_after . ,after))))
- :unpaginate t
- :callback (lambda (value _headers _status _req)
- (funcall cb cb value)))))
-
-(cl-defmethod forge--fetch-pullreq-posts
- ((repo forge-gitlab-repository) cur cb)
- (let-alist (car cur)
- (forge--glab-get repo
- (format "/projects/%s/merge_requests/%s/notes" .target_project_id .iid)
- '((per_page . 100))
- :unpaginate t
- :callback (lambda (value _headers _status _req)
- (setf (alist-get 'notes (car cur)) value)
- (funcall cb cb)))))
-
-(cl-defmethod forge--fetch-pullreq-source-repo
- ((repo forge-gitlab-repository) cur cb)
- ;; If the fork no longer exists, then `.source_project_id' is nil.
- ;; This will lead to difficulties later on but there is nothing we
- ;; can do about it.
- (let-alist (car cur)
- (if .source_project_id
- (forge--glab-get repo (format "/projects/%s" .source_project_id) nil
- :errorback (lambda (_err _headers _status _req)
- (setf (alist-get 'source_project (car cur)) nil)
- (funcall cb cb))
- :callback (lambda (value _headers _status _req)
- (setf (alist-get 'source_project (car cur)) value)
- (funcall cb cb)))
- (setf (alist-get 'source_project (car cur)) nil)
- (funcall cb cb))))
-
-(cl-defmethod forge--fetch-pullreq-target-repo
- ((repo forge-gitlab-repository) cur cb)
- (let-alist (car cur)
- (forge--glab-get repo (format "/projects/%s" .target_project_id) nil
- :errorback (lambda (_err _headers _status _req)
- (setf (alist-get 'target_project (car cur)) nil)
- (funcall cb cb))
- :callback (lambda (value _headers _status _req)
- (setf (alist-get 'target_project (car cur)) value)
- (funcall cb cb)))))
-
-(cl-defmethod forge--update-pullreq ((repo forge-gitlab-repository) data)
- (closql-with-transaction (forge-db)
- (let-alist data
- (let* ((pullreq-id (forge--object-id 'forge-pullreq repo .iid))
- (pullreq
- (forge-pullreq
- :id pullreq-id
- :their-id .iid
- :number .iid
- :slug (format "!%s" .iid)
- :repository (oref repo id)
- :state (pcase-exhaustive .state
- ("merged" 'merged)
- ("closed" 'rejected)
- ("opened" 'open))
- :author .author.username
- :title .title
- :created .created_at
- :updated .updated_at
- ;; `.merged_at' and `.closed_at' may both be nil even
- ;; though the pullreq is merged or otherwise closed.
- ;; In such cases use 1, so that these slots at least
- ;; can serve as booleans.
- :closed (or .closed_at
- (and (member .state '("closed" "merged")) 1))
- :merged (or .merged_at
- (and (equal .state "merged") 1))
- :draft-p .draft
- :locked-p .discussion_locked
- :editable-p .allow_maintainer_to_push
- :cross-repo-p (not (equal .source_project_id
- .target_project_id))
- :base-ref .target_branch
- :base-rev .diff_refs.start_sha
- :base-repo .target_project.path_with_namespace
- :head-ref .source_branch
- :head-rev .diff_refs.head_sha
- :head-user .source_project.owner.username
- :head-repo .source_project.path_with_namespace
- :milestone .milestone.iid
- :body (forge--sanitize-string .description))))
- (closql-insert (forge-db) pullreq t)
- (unless (magit-get-boolean "forge.omitExpensive")
- (forge--set-id-slot repo pullreq 'assignees .assignees)
- (forge--set-id-slot repo pullreq 'review-requests .reviewers)
- (forge--set-id-slot repo pullreq 'labels .labels))
- (dolist (c .notes)
- (let-alist c
- (let ((post
- (forge-pullreq-post
- :id (forge--object-id pullreq-id .id)
- :pullreq pullreq-id
- :number .id
- :author .author.username
- :created .created_at
- :updated .updated_at
- :body (forge--sanitize-string .body))))
- (closql-insert (forge-db) post t))))
- (let ((until (oref repo pullreqs-until)))
- (when (or (not until) (string> .updated_at until))
- (oset repo pullreqs-until .updated_at)))
- pullreq))))
-
-;;;; Other
-
-;; The extend of the documentation for "GET /projects/:id/users" is
-;; "Get the users list of a project." I don't know what that means,
-;; but it stands to reason that this must at least overlap with the
-;; set of users that can be assigned to topics.
-
-(cl-defmethod forge--fetch-assignees ((repo forge-gitlab-repository) callback)
- (forge--glab-get repo "/projects/:project/users"
- '((per_page . 100))
- :unpaginate t
- :callback (lambda (value _headers _status _req)
- (funcall callback callback (cons 'assignees value)))))
-
-(cl-defmethod forge--update-assignees ((repo forge-gitlab-repository) data)
- (oset repo assignees
- (with-slots (id) repo
- (mapcar (lambda (row)
- (let-alist row
- ;; For other forges we don't need to store `id'
- ;; but here we do because that's what has to be
- ;; used when assigning issues.
- (list (forge--object-id id .id)
- .username
- .name
- .id)))
- data))))
-
-(cl-defmethod forge--fetch-forks ((repo forge-gitlab-repository) callback)
- (forge--glab-get repo "/projects/:project/forks"
- '((per_page . 100)
- (simple . t))
- :unpaginate t
- :callback (lambda (value _headers _status _req)
- (funcall callback callback (cons 'forks value)))))
-
-(cl-defmethod forge--update-forks ((repo forge-gitlab-repository) data)
- (oset repo forks
- (with-slots (id) repo
- (mapcar (lambda (row)
- (let-alist row
- (nconc (forge--repository-ids
- (eieio-object-class repo)
- (oref repo githost)
- .namespace.path
- .path)
- (list .namespace.path
- .path))))
- data))))
-
-(cl-defmethod forge--fetch-labels ((repo forge-gitlab-repository) callback)
- (forge--glab-get repo "/projects/:project/labels"
- '((per_page . 100))
- :unpaginate t
- :callback (lambda (value _headers _status _req)
- (funcall callback callback (cons 'labels value)))))
-
-(cl-defmethod forge--update-labels ((repo forge-gitlab-repository) data)
- (oset repo labels
- (with-slots (id) repo
- (mapcar (lambda (row)
- (let-alist row
- ;; We should use the label's `id' instead of its
- ;; `name' but a topic's `labels' field is a list
- ;; of names instead of a list of ids or an alist.
- ;; As a result of this we cannot recognize when
- ;; a label is renamed and a topic continues to be
- ;; tagged with the old label name until it itself
- ;; is modified somehow. Additionally it leads to
- ;; name conflicts between group and project
- ;; labels. See #160.
- (list (forge--object-id id .name)
- .name
- (downcase .color)
- .description)))
- ;; For now simply remove one of the duplicates.
- (cl-delete-duplicates data
- :key (apply-partially #'alist-get 'name)
- :test #'equal)))))
-
-;;;; Notifications
-
-;; The closest to notifications that Gitlab provides are "events" as
-;; described at https://docs.gitlab.com/ee/api/events.html. This
-;; allows us to see the last events that took place, but that is not
-;; good enough because we are mostly interested in events we haven't
-;; looked at yet. Gitlab doesn't make a distinction between unread
-;; and read events, so this is rather useless and we don't use it for
-;; the time being.
-
-;;; Mutations
-
-(cl-defmethod forge--submit-create-issue ((_ forge-gitlab-repository) repo)
- (let-alist (forge--topic-parse-buffer)
- (forge--glab-post repo "/projects/:project/issues"
- `((title . , .title)
- (description . , .body))
- :callback (forge--post-submit-callback)
- :errorback (forge--post-submit-errorback))))
-
-(cl-defmethod forge--submit-create-pullreq ((_ forge-gitlab-repository) base-repo)
- (let-alist (forge--topic-parse-buffer)
- (pcase-let* ((`(,base-remote . ,base-branch)
- (magit-split-branch-name forge--buffer-base-branch))
- (`(,head-remote . ,head-branch)
- (magit-split-branch-name forge--buffer-head-branch))
- (head-repo (forge-get-repository :stub head-remote)))
- (forge--glab-post head-repo "/projects/:project/merge_requests"
- `((title . ,(if (if (local-variable-p 'forge-buffer-draft-p)
- forge-buffer-draft-p
- .draft)
- (concat "Draft: " .title)
- .title))
- (description . , .body)
- ,@(and (not (equal head-remote base-remote))
- `((target_project_id . ,(oref base-repo forge-id))))
- (target_branch . ,base-branch)
- (source_branch . ,head-branch)
- (allow_collaboration . t))
- :callback (forge--post-submit-callback)
- :errorback (forge--post-submit-errorback)))))
-
-(cl-defmethod forge--submit-create-post ((_ forge-gitlab-repository) topic)
- (forge--glab-post topic
- (if (forge-issue-p topic)
- "/projects/:project/issues/:number/notes"
- "/projects/:project/merge_requests/:number/notes")
- `((body . ,(string-trim (buffer-string))))
- :callback (forge--post-submit-callback)
- :errorback (forge--post-submit-errorback)))
-
-(cl-defmethod forge--submit-edit-post ((_ forge-gitlab-repository) post)
- (forge--glab-put post
- (cl-etypecase post
- (forge-pullreq "/projects/:project/merge_requests/:number")
- (forge-issue "/projects/:project/issues/:number")
- (forge-issue-post "/projects/:project/issues/:topic/notes/:number")
- (forge-pullreq-post "/projects/:project/merge_requests/:topic/notes/:number"))
- (if (cl-typep post 'forge-topic)
- (let-alist (forge--topic-parse-buffer)
- ;; Keep Gitlab from claiming that the user
- ;; changed the description when that isn't
- ;; true. The same isn't necessary for the
- ;; title; in that case Gitlab performs the
- ;; necessary check itself.
- `((title . , .title)
- ,@(and (not (equal .body (oref post body)))
- `((description . , .body)))))
- `((body . ,(string-trim (buffer-string)))))
- :callback (forge--post-submit-callback)
- :errorback (forge--post-submit-errorback)))
-
-(cl-defmethod forge--set-topic-field
- ((_repo forge-gitlab-repository) topic field value)
- (forge--glab-put topic
- (cl-typecase topic
- (forge-pullreq "/projects/:project/merge_requests/:number")
- (forge-issue "/projects/:project/issues/:number"))
- `((,field . ,value))
- :callback (forge--set-field-callback topic)))
-
-(cl-defmethod forge--set-topic-title
- ((repo forge-gitlab-repository) topic title)
- (forge--set-topic-field repo topic 'title title))
-
-(cl-defmethod forge--set-topic-state
- ((repo forge-gitlab-repository) topic state)
- (forge--set-topic-field repo topic 'state_event
- (pcase-exhaustive state
- ;; Merging isn't done through here.
- ('completed "close")
- ('unplanned "close")
- ('rejected "close")
- ('open "reopen"))))
-
-(cl-defmethod forge--set-topic-draft
- ((repo forge-gitlab-repository) topic value)
- (let ((buffer (current-buffer)))
- (glab-graphql
- `(mutation (mergeRequestSetDraft
- [(input $input MergeRequestSetDraftInput!)]
- (mergeRequest iid draft)))
- `((input (projectPath . ,(oref repo slug))
- (iid . ,(number-to-string (oref topic number)))
- (draft . ,value)))
- :host (oref (forge-get-repository topic) apihost)
- :auth 'forge
- :callback (lambda (data &rest _)
- (if (assq 'error data)
- (ghub--graphql-pp-response data)
- (oset topic draft-p value)
- (forge-refresh-buffer buffer))))))
-
-(cl-defmethod forge--set-topic-labels
- ((repo forge-gitlab-repository) topic labels)
- (forge--set-topic-field repo topic 'labels
- (string-join labels ",")))
-
-(cl-defmethod forge--set-topic-assignees
- ((repo forge-gitlab-repository) topic assignees)
- (let ((users (mapcar #'cdr (oref repo assignees))))
- (cl-typecase topic
- (forge-pullreq ; Can only be assigned to a single user.
- (forge--set-topic-field repo topic 'assignee_id
- (or (caddr (assoc (car assignees) users))
- 0)))
- (forge-issue
- (forge--set-topic-field repo topic 'assignee_ids
- (or (--map (caddr (assoc it users)) assignees)
- 0))))))
-
-(cl-defmethod forge--set-topic-review-requests
- ((repo forge-gitlab-repository) topic reviewers)
- (let ((users (mapcar #'cdr (oref repo assignees))))
- (forge--set-topic-field repo topic 'reviewer_ids
- (or (--map (caddr (assoc it users)) reviewers)
- 0))))
-
-(cl-defmethod forge--delete-comment
- ((_repo forge-gitlab-repository) post)
- (forge--glab-delete post
- (cl-etypecase post
- (forge-pullreq-post
- "/projects/:project/merge_requests/:topic/notes/:number")
- (forge-issue-post
- "/projects/:project/issues/:topic/notes/:number")))
- (closql-delete post)
- (forge-refresh-buffer))
-
-(cl-defmethod forge--topic-template-files ((repo forge-gitlab-repository)
- (_ (subclass forge-issue)))
- (--filter (string-match-p "\\`\\.gitlab/issue_templates/.+\\.md\\'" it)
- (magit-revision-files (oref repo default-branch))))
-
-(cl-defmethod forge--topic-template-files ((repo forge-gitlab-repository)
- (_ (subclass forge-pullreq)))
- (--filter (string-match-p "\\`\\.gitlab/merge_request_templates/.+\\.md\\'" it)
- (magit-revision-files (oref repo default-branch))))
-
-(cl-defmethod forge--fork-repository ((repo forge-gitlab-repository) fork)
- (with-slots (owner name) repo
- (forge--glab-post repo (format "/projects/%s%%2F%s/fork" owner name)
- (and (not (equal fork (ghub--username (ghub--host nil))))
- `((namespace . ,fork)))
- :noerror t)
- (ghub-wait (format "/projects/%s%%2F%s" fork name)
- nil :auth 'forge :forge 'gitlab)))
-
-(cl-defmethod forge--merge-pullreq ((_repo forge-gitlab-repository)
- topic hash method)
- (forge--glab-put topic
- "/projects/:project/merge_requests/:number/merge"
- `((squash . ,(eq method 'squash))
- ,@(and hash `((sha . ,hash))))))
-
-;;; Wrappers
-
-(cl-defun forge--glab-get (obj resource
- &optional params
- &key query payload headers
- silent unpaginate noerror reader
- host callback errorback)
- (declare (indent defun))
- (glab-get (if obj (forge--format-resource obj resource) resource)
- params
- :host (or host (oref (forge-get-repository obj) apihost))
- :auth 'forge
- :query query :payload payload :headers headers
- :silent silent :unpaginate unpaginate
- :noerror noerror :reader reader
- :callback callback
- :errorback (or errorback (and callback t))))
-
-(cl-defun forge--glab-put (obj resource
- &optional params
- &key query payload headers
- silent unpaginate noerror reader
- host callback errorback)
- (declare (indent defun))
- (glab-put (if obj (forge--format-resource obj resource) resource)
- params
- :host (or host (oref (forge-get-repository obj) apihost))
- :auth 'forge
- :query query :payload payload :headers headers
- :silent silent :unpaginate unpaginate
- :noerror noerror :reader reader
- :callback callback
- :errorback (or errorback (and callback t))))
-
-(cl-defun forge--glab-post (obj resource
- &optional params
- &key query payload headers
- silent unpaginate noerror reader
- host callback errorback)
- (declare (indent defun))
- (glab-post (forge--format-resource obj resource)
- params
- :host (or host (oref (forge-get-repository obj) apihost))
- :auth 'forge
- :query query :payload payload :headers headers
- :silent silent :unpaginate unpaginate
- :noerror noerror :reader reader
- :callback callback
- :errorback (or errorback (and callback t))))
-
-(cl-defun forge--glab-delete (obj resource
- &optional params
- &key query payload headers
- silent unpaginate noerror reader
- host callback errorback)
- (declare (indent defun))
- (glab-delete (forge--format-resource obj resource)
- params
- :host (or host (oref (forge-get-repository obj) apihost))
- :auth 'forge
- :query query :payload payload :headers headers
- :silent silent :unpaginate unpaginate
- :noerror noerror :reader reader
- :callback callback
- :errorback (or errorback (and callback t))))
-
-;;; _
-(provide 'forge-gitlab)
-;;; forge-gitlab.el ends here
+++ /dev/null
-;;; forge-gogs.el --- Gogs support -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2024 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This file is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this file. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'gogs)
-(require 'forge)
-
-;;; Class
-
-(defclass forge-gogs-repository (forge-unusedapi-repository)
- ((issues-url-format :initform "https://%h/%o/%n/issues")
- (issue-url-format :initform "https://%h/%o/%n/issues/%i")
- (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#issuecomment-%I")
- (pullreqs-url-format :initform "https://%h/%o/%n/pulls")
- (pullreq-url-format :initform "https://%h/%o/%n/pulls/%i")
- (pullreq-post-url-format :initform "https://%h/%o/%n/pulls/%i#issuecomment-%I")
- (commit-url-format :initform "https://%h/%o/%n/commit/%r")
- (branch-url-format :initform "https://%h/%o/%n/commits/%r")
- (remote-url-format :initform "https://%h/%o/%n")
- (create-issue-url-format :initform "https://%h/%o/%n/issues/new")
- (create-pullreq-url-format :initform "https://%h/%o/%n/pulls") ; sic
- (pullreq-refspec :initform "+refs/pull/*/head:refs/pullreqs/*")))
-
-;;; _
-(provide 'forge-gogs)
-;;; forge-gogs.el ends here
+++ /dev/null
-;;; forge-issue.el --- Issue support -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2024 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This file is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this file. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'forge)
-(require 'forge-post)
-(require 'forge-topic)
-
-;;; Classes
-
-(defclass forge-issue (forge-topic)
- ((closql-table :initform 'issue)
- (closql-primary-key :initform 'id)
- (closql-order-by :initform [(desc number)])
- (closql-foreign-key :initform 'repository)
- (closql-class-prefix :initform "forge-")
- (id :initarg :id)
- (repository :initarg :repository)
- (number :initarg :number)
- (state :initarg :state)
- (author :initarg :author)
- (title :initarg :title)
- (created :initarg :created)
- (updated :initarg :updated :initform nil)
- (closed :initarg :closed)
- (status :initarg :status :initform nil)
- (locked-p :initarg :locked-p)
- (milestone :initarg :milestone)
- (body :initarg :body)
- (assignees :closql-tables (issue-assignee assignee))
- (project-cards) ; projectsCards
- (edits) ; userContentEdits
- (labels :closql-tables (issue-label label))
- (participants)
- (posts :closql-class forge-issue-post)
- (reactions)
- (timeline)
- (marks :closql-tables (issue-mark mark))
- (note :initarg :note :initform nil)
- (their-id :initarg :their-id)
- (slug :initarg :slug)
- (saved-p :initarg :saved-p :initform nil)
- ))
-
-(cl-defmethod closql-dref ((obj forge-issue) (_(eql assignees)))
- (forge-sql-cdr
- [:select assignee:* :from assignee
- :join issue-assignee :on (= issue-assignee:id assignee:id)
- :where (= issue-assignee:issue $s1)
- :order-by [(asc login)]]
- (closql--oref obj 'id)))
-
-(cl-defmethod closql-dref ((obj forge-issue) (_(eql labels)))
- (forge-sql-cdr
- [:select label:* :from label
- :join issue-label :on (= issue-label:id label:id)
- :where (= issue-label:issue $s1)
- :order-by [(asc name)]]
- (closql--oref obj 'id)))
-
-(cl-defmethod closql-dref ((obj forge-issue) (_(eql marks)))
- (forge-sql-cdr
- [:select mark:* :from mark
- :join issue-mark :on (= issue-mark:id mark:id)
- :where (= issue-mark:issue $s1)
- :order-by [(asc name)]]
- (closql--oref obj '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
-;;;; Get
-
-(cl-defmethod forge-get-repository ((post forge-issue-post))
- (forge-get-repository (forge-get-issue post)))
-
-(cl-defmethod forge-get-topic ((post forge-issue-post))
- (forge-get-issue post))
-
-(cl-defmethod forge-get-issue ((issue forge-issue))
- issue)
-
-(cl-defmethod forge-get-issue ((repo forge-repository) number)
- (closql-get (forge-db)
- (forge--object-id 'forge-issue repo number)
- 'forge-issue))
-
-(cl-defmethod forge-get-issue ((number integer))
- (and-let* ((repo (forge-get-repository :tracked nil 'notatpt)))
- (forge-get-issue repo number)))
-
-(cl-defmethod forge-get-issue ((id string))
- (closql-get (forge-db) id 'forge-issue))
-
-(cl-defmethod forge-get-issue ((post forge-issue-post))
- (closql-get (forge-db)
- (oref post issue)
- 'forge-issue))
-
-;;;; Current
-
-(defun forge-current-issue (&optional demand)
- "Return the issue at point or being visited.
-If there is no such issue and DEMAND is non-nil, then signal
-an error."
- (or (forge-issue-at-point)
- (and (forge-issue-p forge-buffer-topic)
- forge-buffer-topic)
- (and demand (user-error "No current issue"))))
-
-(defun forge-issue-at-point (&optional demand)
- "Return the issue at point.
-If there is no such issue and DEMAND is non-nil, then signal
-an error."
- (or (thing-at-point 'forge-issue)
- (magit-section-value-if 'issue)
- (and demand (user-error "No issue at point"))))
-
-(put 'forge-issue 'thing-at-point #'forge-thingatpt--issue)
-(defun forge-thingatpt--issue ()
- (and-let* ((repo (forge--repo-for-thingatpt)))
- (and (thing-at-point-looking-at "#\\([0-9]+\\)\\_>")
- (forge-get-issue repo (string-to-number (match-string 1))))))
-
-;;; Read
-
-(defun forge-read-issue (prompt)
- "Read an active issue with completion using PROMPT.
-
-Open, unread and pending issues are considered active.
-Default to the current issue, even if it isn't active.
-
-\\<forge-read-topic-minibuffer-map>While completion is in \
-progress, \\[forge-read-topic-lift-limit] lifts the limit, extending
-the completion candidates to include all issues.
-
-If `forge-limit-topic-choices' is nil, then all candidates
-can be selected from the start."
- (forge--read-topic prompt
- #'forge-current-issue
- (forge--topics-spec :type 'issue :active t)
- (forge--topics-spec :type 'issue :active nil :state nil)))
-
-(defun forge-read-open-issue (prompt)
- "Read an open issue with completion using PROMPT."
- (let* ((current (forge-current-issue))
- (repo (forge-get-repository (or current :tracked)))
- (default (and current (forge--format-topic-line current)))
- (alist (forge--topic-collection
- (forge--list-topics
- (forge--topics-spec :type 'issue :state 'open)
- repo)))
- (choices (mapcar #'car alist))
- (choice (magit-completing-read prompt choices nil t nil nil default)))
- (cdr (assoc choice alist))))
-
-;;; Insert
-
-(defvar-keymap forge-issues-section-map
- :parent forge-common-map
- "<remap> <magit-browse-thing>" #'forge-browse-issues
- "<remap> <magit-visit-thing>" #'forge-list-issues
- "<remap> <forge--list-menu>" #'forge-topics-menu
- "<remap> <forge--item-menu>" #'forge-topic-menu
- "C-c C-n" #'forge-create-issue)
-
-(defvar-keymap forge-issue-section-map
- :parent forge-common-map
- "<remap> <magit-visit-thing>" #'forge-visit-this-topic
- "<remap> <forge--list-menu>" #'forge-topics-menu
- "<remap> <forge--item-menu>" #'forge-topic-menu)
-
-(cl-defun forge-insert-issues (&optional (spec nil sspec) heading)
- "Insert a list of issues, according to `forge--buffer-topics-spec'.
-Optional SPEC can be used to override that filtering specification,
-and optional HEADING to change the section heading."
- (when-let (((forge-db t))
- (repo (forge-get-repository :tracked?))
- ((oref repo issues-p))
- (spec (if sspec spec (forge--clone-buffer-topics-spec)))
- ((memq (oref spec type) '(topic issue))))
- (oset spec type 'issue)
- (forge--insert-topics 'issues
- (or heading "Issues")
- (forge--list-topics spec repo))))
-
-;;; _
-(provide 'forge-issue)
-;;; forge-issue.el ends here
+++ /dev/null
-;;; forge-notify.el --- Notify support -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2024 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This file is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this file. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'forge)
-(require 'forge-topic)
-
-;;; Class
-
-(defclass forge-notification (forge-object)
- ((closql-class-prefix :initform "forge-")
- (closql-table :initform 'notification)
- (closql-primary-key :initform 'id)
- (closql-order-by :initform [(desc id)])
- (id :initarg :id)
- (thread-id :initarg :thread-id)
- (repository :initarg :repository)
- (type :initarg :type)
- (topic :initarg :topic)
- (url :initarg :url)
- (title :initarg :title)
- (reason :initarg :reason)
- (last-read :initarg :last-read)
- (updated :initarg :updated)))
-
-;;; Query
-;;;; Get
-
-(cl-defmethod forge-get-repository ((notify forge-notification))
- "Return the object for the repository that NOTIFY belongs to."
- (and-let* ((id (oref notify repository)))
- (closql-get (forge-db) id 'forge-repository)))
-
-(cl-defmethod forge-get-topic ((notify forge-notification))
- (and-let* ((repo (forge-get-repository notify)))
- (forge-get-topic repo (oref notify topic))))
-
-(cl-defmethod forge-get-notification ((id string))
- (closql-get (forge-db) id 'forge-notification))
-
-(cl-defmethod forge-get-notification ((topic forge-topic))
- (and-let* ((row (car (forge-sql [:select * :from notification
- :where (and (= repository $s1)
- (= topic $s2))]
- (oref topic repository)
- (oref topic number)))))
- (closql--remake-instance 'forge-notification (forge-db) row)))
-
-;;;; Current
-
-(defun forge-current-notification (&optional demand)
- "Return the current notification, casting a topic if necessary.
-If there is no such notification and DEMAND is non-nil, then
-signal an error."
- (or (magit-section-value-if 'notification)
- (and-let* ((topic (forge-current-topic)))
- (forge-get-notification topic))
- (and demand (user-error "No current notification"))))
-
-(defun forge-notification-at-point (&optional demand)
- "Return the notification at point, casting a topic if necessary.
-If there is no such notification and DEMAND is non-nil, then
-signal an error."
- (or (magit-section-value-if 'notification)
- (and-let* ((topic (forge-topic-at-point)))
- (forge-get-notification topic))
- (and demand (user-error "No notification at point"))))
-
-;;;; List
-
-(defun forge--ls-notifications (status)
- (let* ((status (ensure-list status))
- (savedp (memq 'saved status))
- (status (remq 'saved status)))
- (mapcar
- (lambda (row) (closql--remake-instance 'forge-notification (forge-db) row))
- (if (seq-set-equal-p status '(unread pending done) #'eq)
- (forge-sql [:select * :from notification :order-by [(desc updated)]])
- (forge-sql
- `[:select :distinct notification:*
- :from [notification (as issue topic)]
- :where (and (= notification:topic topic:id)
- ,@(and status '((in topic:status $v1)))
- ,@(and savedp '((= topic:saved-p 't))))
- :union
- :select :distinct notification:*
- :from [notification (as pullreq topic)]
- :where (and (= notification:topic topic:id)
- ,@(and status '((in topic:status $v1)))
- ,@(and savedp '((= topic:saved-p 't))))
- :order-by [(desc notification:updated)]]
- (vconcat status))))))
-
-;;; Mode
-
-(defvar-keymap forge-notifications-mode-map
- :doc "Keymap for `forge-notifications-mode'."
- :parent (make-composed-keymap forge-common-map magit-mode-map)
- "<remap> <magit-refresh>" #'magit-refresh-buffer
- "<remap> <forge--list-menu>" #'forge-notifications-menu)
-
-(define-derived-mode forge-notifications-mode magit-mode "Forge Notifications"
- "Major mode for looking at forge notifications."
- :interactive nil
- (magit-hack-dir-local-variables))
-
-(defun forge-notifications-setup-buffer ()
- (magit-setup-buffer-internal #'forge-notifications-mode nil
- '((default-directory "/")
- (forge-buffer-unassociated-p t))
- (get-buffer-create "*forge-notifications*")))
-
-(defun forge-notifications-refresh-buffer ()
- (magit-set-header-line-format (forge-notifications-buffer-desc))
- (forge-insert-notifications))
-
-(defun forge-notifications-buffer-desc ()
- (let ((status forge-notifications-selection))
- (cond
- ((not (listp status))
- (format "%s notifications" (capitalize (symbol-name status))))
- ((seq-set-equal-p status '(unread pending)) "Inbox")
- ((seq-set-equal-p status '(unread pending done)) "All notifications")
- ((format "Notifications %s" status)))))
-
-(defvar forge-notifications-display-style 'flat)
-(defvar forge-notifications-selection '(unread pending))
-
-;;; Commands
-
-(transient-define-prefix forge-notifications-menu ()
- "Control list of notifications and notification at point."
- :transient-suffix t
- :transient-non-suffix #'transient--do-call
- :transient-switch-frame nil
- :refresh-suffixes t
- :environment #'forge--menu-environment
- :column-widths forge--topic-menus-column-widths
- [:hide always ("q" forge-menu-quit-list)]
- [forge--topic-menus-group
- ["Selection"
- ("I" forge-notifications-display-inbox)
- ("S" forge-notifications-display-saved)
- ("D" forge-notifications-display-done)
- ("A" forge-notifications-display-all)]]
- [forge--lists-group
- ["Display"
- ("-F" forge-notifications-style-flat)
- ("-G" forge-notifications-style-nested)
- ("-H" forge-toggle-topic-legend)]]
- [forge--topic-legend-group]
- (interactive)
- (unless (derived-mode-p 'forge-notifications-mode)
- (forge-list-notifications))
- (transient-setup 'forge-notifications-menu))
-
-(transient-augment-suffix forge-notifications-menu
- :transient #'transient--do-replace
- :if-mode 'forge-notifications-mode
- :inapt-if (lambda () (eq (oref transient--prefix command) 'forge-notifications-menu))
- :inapt-face 'forge-suffix-active)
-
-;;;###autoload(autoload 'forge-list-notifications "forge-notify" nil t)
-(transient-define-suffix forge-list-notifications ()
- "List notifications."
- :inapt-if-mode 'forge-notifications-mode
- :inapt-face 'forge-suffix-active
- (declare (interactive-only nil))
- (interactive)
- (forge-notifications-setup-buffer)
- (transient-setup 'forge-notifications-menu))
-
-(transient-define-suffix forge-notifications-display-inbox ()
- "List unread and pending notifications."
- :description "inbox"
- :inapt-if (lambda () (equal forge-notifications-selection '(unread pending)))
- :inapt-face 'forge-suffix-active
- (interactive)
- (unless (derived-mode-p 'forge-notifications-mode)
- (user-error "Not in notification buffer"))
- (setq forge-notifications-selection '(unread pending))
- (forge-refresh-buffer))
-
-(transient-define-suffix forge-notifications-display-saved ()
- "List saved notifications."
- :description "saved"
- :inapt-if (lambda () (eq forge-notifications-selection 'saved))
- :inapt-face 'forge-suffix-active
- (interactive)
- (unless (derived-mode-p 'forge-notifications-mode)
- (user-error "Not in notification buffer"))
- (setq forge-notifications-selection 'saved)
- (forge-refresh-buffer))
-
-(transient-define-suffix forge-notifications-display-done ()
- "List done notifications."
- :description "done"
- :inapt-if (lambda () (eq forge-notifications-selection 'done))
- :inapt-face 'forge-suffix-active
- (interactive)
- (unless (derived-mode-p 'forge-notifications-mode)
- (user-error "Not in notification buffer"))
- (setq forge-notifications-selection 'done)
- (forge-refresh-buffer))
-
-(transient-define-suffix forge-notifications-display-all ()
- "List all notifications."
- :description "all"
- :inapt-if (lambda () (equal forge-notifications-selection '(unread pending done)))
- :inapt-face 'forge-suffix-active
- (interactive)
- (unless (derived-mode-p 'forge-notifications-mode)
- (user-error "Not in notification buffer"))
- (setq forge-notifications-selection '(unread pending done))
- (forge-refresh-buffer))
-
-(transient-define-suffix forge-notifications-style-flat ()
- "Show a flat notification list."
- :description "single list"
- :inapt-if (lambda () (eq forge-notifications-display-style 'flat))
- :inapt-face 'forge-suffix-active
- (interactive)
- (unless (derived-mode-p 'forge-notifications-mode)
- (user-error "Not in notification buffer"))
- (setq forge-notifications-display-style 'flat)
- (forge-refresh-buffer))
-
-(transient-define-suffix forge-notifications-style-nested ()
- "Group notifications by repository."
- :description "group by repo"
- :inapt-if (lambda () (eq forge-notifications-display-style 'nested))
- :inapt-face 'forge-suffix-active
- (interactive)
- (unless (derived-mode-p 'forge-notifications-mode)
- (user-error "Not in notification buffer"))
- (setq forge-notifications-display-style 'nested)
- (forge-refresh-buffer))
-
-;;; Sections
-
-(defclass forge-repository-section (magit-section)
- ((type :initform 'forge-repo)
- (keymap :initform 'forge-repository-section-map)))
-
-(define-obsolete-variable-alias 'forge-forge-repo-section-map
- 'forge-repository-section-map "Forge 0.4.0")
-
-(defvar-keymap forge-repository-section-map
- "<remap> <magit-browse-thing>" #'forge-browse-this-repository
- "<remap> <magit-visit-thing>" #'forge-visit-this-repository)
-
-(defun forge-insert-notifications ()
- (let ((notifs (forge--ls-notifications forge-notifications-selection)))
- (magit-insert-section (notifications)
- (cond
- ((not notifs)
- (insert "(empty)\n"))
- ((eq forge-notifications-display-style 'flat)
- (magit-insert-section-body
- (dolist (notif notifs)
- (forge-insert-notification notif))
- (insert ?\n)))
- ((pcase-dolist (`(,_ . ,notifs)
- (--group-by (oref it repository) notifs))
- (let ((repo (forge-get-repository (car notifs))))
- (magit-insert-section (forge-repo repo)
- (magit-insert-heading
- (concat (propertize (oref repo slug) 'font-lock-face 'bold)
- (format " (%s)" (length notifs))))
- (magit-insert-section-body
- (dolist (notif notifs)
- (forge-insert-notification notif))
- (insert ?\n))))))))))
-
-(defun forge-insert-notification (notif)
- (with-slots (type title url) notif
- (pcase type
- ((or 'issue 'pullreq)
- (forge--insert-topic (forge-get-topic notif)))
- ('commit
- (magit-insert-section (ncommit nil) ; !commit
- (string-match "[^/]*\\'" url)
- (insert
- (format "%s %s\n"
- (propertize (substring (match-string 0 url)
- 0 (magit-abbrev-length))
- 'font-lock-face 'magit-hash)
- (magit-log-propertize-keywords
- nil
- (propertize title 'font-lock-face
- (if-let ((topic (oref notif topic))
- ((eq (oref topic status) 'unread)))
- 'forge-topic-unread
- 'forge-topic-open)))))))
- (_
- ;; The documentation does not mention what "types"
- ;; exist. Make it obvious that this is something
- ;; we do not know how to handle properly yet.
- (magit-insert-section (notification notif)
- (insert (propertize (format "(%s) %s\n" type title)
- 'font-lock-face 'error)))))))
-
-;;; _
-(provide 'forge-notify)
-;;; forge-notify.el ends here
+++ /dev/null
-;; -*- no-byte-compile: t; lexical-binding: nil -*-
-(define-package "forge" "20241218.2036"
- "Access Git forges from Magit."
- '((emacs "29.1")
- (compat "30.0.0.0")
- (closql "2.1.0")
- (dash "2.19.1")
- (emacsql "4.1.0")
- (ghub "4.2.0")
- (let-alist "1.0.6")
- (magit "4.1.3")
- (markdown-mode "2.6")
- (seq "2.24")
- (transient "0.8.0")
- (yaml "0.5.5"))
- :url "https://github.com/magit/forge"
- :commit "3b80ace32c23c030d8c12dd9bf266962718545cf"
- :revdesc "3b80ace32c23"
- :keywords '("git" "tools" "vc")
- :authors '(("Jonas Bernoulli" . "emacs.forgeNOSPAMjonas.bernoulli.dev"))
- :maintainers '(("Jonas Bernoulli" . "emacs.forgeNOSPAMjonas.bernoulli.dev")))
+++ /dev/null
-;;; forge-post.el --- Post support -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2024 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This file is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this file. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'markdown-mode)
-
-(require 'forge)
-
-;;; Options
-
-(defcustom forge-post-mode-hook
- '(visual-line-mode
- turn-on-flyspell)
- "Hook run after entering Forge-Post mode."
- :package-version '(forge . "0.2.0")
- :group 'forge
- :type 'hook
- :options '(visual-line-mode
- turn-on-flyspell))
-
-(defcustom forge-buffer-draft-p nil
- "Whether new pull-requests start out as drafts by default.
-
-The buffer-local value is used to keep track of the draft status
-of the current pull-request."
- :package-version '(forge . "0.4.0")
- :group 'forge
- :type 'boolean)
-
-;;; Class
-
-(defclass forge-post (forge-object) () :abstract t)
-
-;;; Query
-;;;; Get
-
-(cl-defmethod forge-get-parent ((post forge-post))
- (forge-get-topic post))
-
-(cl-defmethod forge-get-repository ((post forge-post))
- (forge-get-repository (forge-get-topic post)))
-
-;;;; Current
-
-(defun forge-post-at-point (&optional assert)
- "Return the post at point.
-If there is no such post and DEMAND is non-nil, then signal
-an error."
- (or (magit-section-value-if '(issue pullreq post))
- (and assert (user-error "There is no post at point"))))
-
-(defun forge-comment-at-point (&optional assert)
- "Return the comment at point.
-If there is no such comment and DEMAND is non-nil, then signal
-an error."
- (or (and (magit-section-value-if '(post))
- (let ((post (oref (magit-current-section) value)))
- (and (or (forge-pullreq-post-p post)
- (forge-issue-post-p post))
- post)))
- (and assert (user-error "There is no comment at point"))))
-
-;;; Utilities
-
-(cl-defmethod forge--format ((post forge-post) slot &optional spec)
- (forge--format (forge-get-topic post) slot
- `(,@spec (?I . ,(oref post number)))))
-
-;;; Mode
-
-(defvar-keymap forge-post-mode-map
- "C-c C-e" #'forge-post-dispatch
- "C-c C-c" #'forge-post-submit
- "<remap> <evil-save-and-close>" #'forge-post-submit
- "<remap> <evil-save-modified-and-close>" #'forge-post-submit
- "C-c C-k" #'forge-post-cancel
- "<remap> <kill-buffer>" #'forge-post-cancel
- "<remap> <ido-kill-buffer>" #'forge-post-cancel
- "<remap> <iswitchb-kill-buffer>" #'forge-post-cancel
- "<remap> <evil-quit>" #'forge-post-cancel)
-
-(define-derived-mode forge-post-mode gfm-mode "Forge-Post"
- "Major mode for editing topic posts."
- :interactive nil)
-
-(defvar-local forge--buffer-base-branch nil)
-(defvar-local forge--buffer-head-branch nil)
-(defvar-local forge--buffer-post-object nil)
-(defvar-local forge--buffer-issue nil)
-(defvar-local forge--submit-post-function nil)
-(defvar-local forge--cancel-post-function nil)
-(defvar-local forge--pre-post-buffer nil)
-(make-variable-buffer-local 'forge-buffer-draft-p)
-
-(defun forge--prepare-post-buffer (filename &optional header source target)
- (let ((file (convert-standard-filename
- (expand-file-name (concat "magit/posts/" filename)
- (magit-gitdir)))))
- (make-directory (file-name-directory file) t)
- (let ((prevbuf (current-buffer))
- (resume (and (file-exists-p file)
- (> (file-attribute-size (file-attributes file)) 0)))
- (buf (find-file-noselect file)))
- (with-current-buffer buf
- (forge-post-mode)
- (when header
- (magit-set-header-line-format header))
- (setq forge--pre-post-buffer prevbuf)
- (when resume
- (forge--display-post-buffer buf)
- (when (magit-read-char-case "A draft already exists. " nil
- (?r "[r]esume editing existing draft")
- (?d "[d]iscard draft and start over" t))
- (erase-buffer)
- (setq resume nil)))
- (when (and (not resume) (string-prefix-p "new" filename))
- (let-alist (forge--topic-template
- (forge-get-repository :tracked)
- (if source 'forge-pullreq 'forge-issue))
- (cond
- (.url
- (browse-url .url)
- (forge-post-cancel)
- (setq buf nil)
- (message "Using browser to visit %s instead of opening an issue"
- .url))
- (.name
- ;; A Github issue with yaml frontmatter.
- (save-excursion (insert .text))
- (unless (re-search-forward "^title: " nil t)
- (when (re-search-forward "^---" nil t 2)
- (beginning-of-line)
- (insert "title: \n")
- (backward-char))))
- (t
- (insert "# ")
- (let ((single
- (and source
- (= (car (magit-rev-diff-count source target)) 1))))
- (save-excursion
- (when single
- ;; A pull-request.
- (magit-rev-insert-format "%B" source))
- (when .text
- (if single
- (insert "-------\n")
- (insert "\n"))
- (insert "\n" .text)))))))))
- buf)))
-
-(defun forge--display-post-buffer (buf)
- (magit-display-buffer buf #'display-buffer))
-
-(defun forge-post-cancel ()
- "Cancel the post that is being edited in the current buffer."
- (interactive)
- (save-buffer)
- (if-let ((fn forge--cancel-post-function))
- (funcall fn forge--buffer-post-object)
- (magit-mode-bury-buffer 'kill)))
-
-(defun forge-post-submit ()
- "Submit the post that is being edited in the current buffer."
- (interactive)
- (save-buffer)
- (if-let ((fn forge--submit-post-function))
- (funcall fn
- (forge-get-repository forge--buffer-post-object)
- forge--buffer-post-object)
- (error "forge--submit-post-function is nil")))
-
-(defun forge--post-submit-callback ()
- (let* ((file buffer-file-name)
- (editbuf (current-buffer))
- (prevbuf forge--pre-post-buffer)
- (topic (ignore-errors (forge-get-topic forge--buffer-post-object)))
- (repo (forge-get-repository topic)))
- (lambda (value headers status req)
- (run-hook-with-args 'forge-post-submit-callback-hook
- value headers status req)
- (delete-file file t)
- (let ((dir (file-name-directory file)))
- (unless (cddr (directory-files dir nil nil t))
- (delete-directory dir nil t)))
- (when (buffer-live-p editbuf)
- (with-current-buffer editbuf
- (magit-mode-bury-buffer 'kill)))
- (with-current-buffer
- (if (buffer-live-p prevbuf) prevbuf (current-buffer))
- (if (and topic
- (forge--childp repo 'forge-github-repository)
- (oref repo selective-p))
- (forge--pull-topic repo topic)
- (forge-pull))))))
-
-(defun forge--post-submit-errorback ()
- (lambda (error &rest _)
- (error "Failed to submit post: %S" error)))
-
-(transient-define-prefix forge-post-dispatch ()
- "Dispatch a post creation command."
- ["Variables"
- ("d" "Create draft" forge-post-toggle-draft)]
- ["Act"
- ("C-c" "Submit" forge-post-submit)
- ("C-k" "Cancel" forge-post-cancel)])
-
-(transient-define-infix forge-post-toggle-draft ()
- "Toggle whether the pull-request being created is a draft."
- :class 'transient-lisp-variable
- :variable 'forge-buffer-draft-p
- :reader (lambda (&rest _) (not forge-buffer-draft-p))
- :if (lambda () (equal (file-name-nondirectory buffer-file-name) "new-pullreq")))
-
-;;; Notes
-
-(defclass forge-note (forge-post) ())
-
-(defvar-keymap forge-note-section-map
- "<remap> <magit-edit-thing>" #'forge-edit-topic-note)
-
-(defun forge--save-note (_repo topic)
- (let ((value (string-trim (buffer-substring-no-properties
- (point-min)
- (point-max)))))
- (oset topic note (if (equal value "") nil value)))
- (delete-file buffer-file-name t)
- (let ((dir (file-name-directory buffer-file-name)))
- (unless (cddr (directory-files dir nil nil t))
- (delete-directory dir)))
- (let ((prevbuf forge--pre-post-buffer))
- (magit-mode-bury-buffer 'kill)
- (forge-refresh-buffer prevbuf)))
-
-;;; _
-(provide 'forge-post)
-;;; forge-post.el ends here
+++ /dev/null
-;;; forge-pullreq.el --- Pullreq support -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2024 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This file is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this file. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'forge)
-(require 'forge-post)
-(require 'forge-topic)
-
-;;; Classes
-
-(defclass forge-pullreq (forge-topic)
- ((closql-table :initform 'pullreq)
- (closql-primary-key :initform 'id)
- (closql-order-by :initform [(desc number)])
- (closql-foreign-key :initform 'repository)
- (closql-class-prefix :initform "forge-")
- (id :initarg :id)
- (repository :initarg :repository)
- (number :initarg :number)
- (state :initarg :state)
- (author :initarg :author)
- (title :initarg :title)
- (created :initarg :created)
- (updated :initarg :updated :initform nil)
- (closed :initarg :closed)
- (merged :initarg :merged)
- (status :initarg :status :initform nil)
- (locked-p :initarg :locked-p)
- (editable-p :initarg :editable-p)
- (cross-repo-p :initarg :cross-repo-p)
- (base-ref :initarg :base-ref)
- (base-repo :initarg :base-repo)
- (head-ref :initarg :head-ref)
- (head-user :initarg :head-user)
- (head-repo :initarg :head-repo)
- (milestone :initarg :milestone)
- (body :initarg :body)
- (assignees :closql-tables (pullreq-assignee assignee))
- (project-cards) ; projectsCards
- (commits)
- (edits) ; userContentEdits
- (labels :closql-tables (pullreq-label label))
- (participants)
- (posts :closql-class forge-pullreq-post)
- (reactions)
- (review-requests :closql-tables (pullreq-review-request assignee))
- (reviews)
- (timeline)
- (marks :closql-tables (pullreq-mark mark))
- (note :initarg :note :initform nil)
- (base-rev :initarg :base-rev)
- (head-rev :initarg :head-rev)
- (draft-p :initarg :draft-p)
- (their-id :initarg :their-id)
- (slug :initarg :slug)
- (saved-p :initarg :saved-p :initform nil)
- ))
-
-(cl-defmethod closql-dref ((obj forge-pullreq) (_(eql assignees)))
- (forge-sql-cdr
- [:select assignee:* :from assignee
- :join pullreq-assignee :on (= pullreq-assignee:id assignee:id)
- :where (= pullreq-assignee:pullreq $s1)
- :order-by [(asc login)]]
- (closql--oref obj 'id)))
-
-(cl-defmethod closql-dref ((obj forge-pullreq) (_(eql labels)))
- (forge-sql-cdr
- [:select label:* :from label
- :join pullreq-label :on (= pullreq-label:id label:id)
- :where (= pullreq-label:pullreq $s1)
- :order-by [(asc name)]]
- (closql--oref obj 'id)))
-
-(cl-defmethod closql-dref ((obj forge-pullreq) (_(eql review-requests)))
- (forge-sql-cdr
- [:select assignee:* :from assignee
- :join pullreq-review-request :on (= pullreq-review-request:id assignee:id)
- :where (= pullreq-review-request:pullreq $s1)
- :order-by [(asc login)]]
- (closql--oref obj 'id)))
-
-(cl-defmethod closql-dref ((obj forge-pullreq) (_(eql marks)))
- (forge-sql-cdr
- [:select mark:* :from mark
- :join pullreq-mark :on (= pullreq-mark:id mark:id)
- :where (= pullreq-mark:pullreq $s1)
- :order-by [(asc name)]]
- (closql--oref obj '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
-;;;; Get
-
-(cl-defmethod forge-get-repository ((post forge-pullreq-post))
- (forge-get-repository (forge-get-pullreq post)))
-
-(cl-defmethod forge-get-topic ((post forge-pullreq-post))
- (forge-get-pullreq post))
-
-(cl-defmethod forge-get-pullreq ((pullreq forge-pullreq))
- pullreq)
-
-(cl-defmethod forge-get-pullreq ((repo forge-repository) number)
- (closql-get (forge-db)
- (forge--object-id 'forge-pullreq repo number)
- 'forge-pullreq))
-
-(cl-defmethod forge-get-pullreq ((number integer))
- (and-let* ((repo (forge-get-repository :tracked nil 'notatpt)))
- (forge-get-pullreq repo number)))
-
-(cl-defmethod forge-get-pullreq ((id string))
- (closql-get (forge-db) id 'forge-pullreq))
-
-(cl-defmethod forge-get-pullreq ((post forge-pullreq-post))
- (closql-get (forge-db)
- (oref post pullreq)
- 'forge-pullreq))
-
-(cl-defmethod forge-get-pullreq ((_(eql :branch)) &optional branch)
- (and-let* ((branch (or branch
- (magit-section-case
- (branch (oref it value))
- (commit (magit--painted-branch-at-point)))))
- (branch (cdr (magit-split-branch-name branch)))
- (number (magit-get "branch" branch "pullRequest")))
- (forge-get-pullreq (string-to-number number))))
-
-;;;; Current
-
-(defun forge-current-pullreq (&optional demand)
- "Return the pull-request at point or being visited.
-If there is no such pull-request and DEMAND is non-nil, then signal
-an error."
- (or (forge-pullreq-at-point)
- (and (forge-pullreq-p forge-buffer-topic)
- forge-buffer-topic)
- (and demand (user-error "No current pull-request"))))
-
-(defun forge-pullreq-at-point (&optional demand)
- "Return the pull-request at point.
-If there is no such pull-request and DEMAND is non-nil, then signal
-an error."
- (or (thing-at-point 'forge-pullreq)
- (magit-section-value-if 'pullreq)
- (forge-get-pullreq :branch)
- (and demand (user-error "No pull-request at point"))))
-
-(put 'forge-pullreq 'thing-at-point #'forge-thingatpt--pullreq)
-(defun forge-thingatpt--pullreq ()
- (and-let* ((repo (forge--repo-for-thingatpt)))
- (and (thing-at-point-looking-at
- (if (forge-gitlab-repository--eieio-childp repo)
- "[#!]\\([0-9]+\\)\\_>"
- "#\\([0-9]+\\)\\_>"))
- (forge-get-pullreq repo (string-to-number (match-string 1))))))
-
-;;; Read
-
-(defun forge-read-pullreq (prompt)
- "Read an active pull-request with completion using PROMPT.
-
-Open, unread and pending pull-requests are considered active.
-Default to the current pull-request, even if it isn't active.
-
-\\<forge-read-topic-minibuffer-map>While completion is in \
-progress, \\[forge-read-topic-lift-limit] lifts the limit, extending
-the completion candidates to include all pull-requests.
-
-If `forge-limit-topic-choices' is nil, then all candidates
-can be selected from the start."
- (forge--read-topic prompt
- #'forge-current-pullreq
- (forge--topics-spec :type 'pullreq :active t)
- (forge--topics-spec :type 'pullreq :active nil :state nil)))
-
-;;; Utilities
-
-(defun forge--pullreq-branch-internal (pullreq)
- (let ((branch (oref pullreq head-ref)))
- ;; It is invalid for a branch name to begin with a colon, yet
- ;; that is what Gitlab uses when a pull-request's source branch
- ;; has been deleted. On Github this is simply nil in the same
- ;; situation.
- (and branch (not (string-prefix-p ":" branch)) branch)))
-
-(defun forge--pullreq-branch-active (pullreq)
- (let* ((number (number-to-string (oref pullreq number)))
- (branch-n (format "pr-%s" number))
- (branch (forge--pullreq-branch-internal pullreq)))
- (or (and (magit-branch-p branch)
- (equal (magit-get "branch" branch "pullRequest") number)
- branch)
- (and (magit-branch-p branch-n)
- (equal (magit-get "branch" branch-n "pullRequest") number)
- branch-n))))
-
-(defun forge--pullreq-ref (pullreq)
- (let ((ref (format "refs/pullreqs/%s" (oref pullreq number))))
- (and (magit-rev-verify ref) ref)))
-
-(defun forge--pullreq-range (pullreq &optional endpoints)
- (and-let* ((head (forge--pullreq-ref pullreq)))
- (concat (forge--get-remote) "/" (oref pullreq base-ref)
- (if endpoints "..." "..")
- head)))
-
-;;; Insert
-
-(defvar-keymap forge-pullreqs-section-map
- :parent forge-common-map
- "<remap> <magit-browse-thing>" #'forge-browse-pullreqs
- "<remap> <magit-visit-thing>" #'forge-list-pullreqs
- "<remap> <forge--list-menu>" #'forge-topics-menu
- "<remap> <forge--item-menu>" #'forge-topic-menu
- "C-c C-n" #'forge-create-pullreq)
-
-(defvar-keymap forge-pullreq-section-map
- :parent forge-common-map
- "<remap> <magit-visit-thing>" #'forge-visit-this-topic
- "<remap> <forge--list-menu>" #'forge-topics-menu
- "<remap> <forge--item-menu>" #'forge-topic-menu)
-
-(cl-defun forge-insert-pullreqs (&optional (spec nil sspec) heading)
- "Insert a list of pull-requests, according to `forge--buffer-topics-spec'.
-Optional SPEC can be used to override that filtering specification,
-and optional HEADING to change the section heading."
- (when-let (((forge-db t))
- (repo (forge-get-repository :tracked?))
- (spec (if sspec spec (forge--clone-buffer-topics-spec)))
- ((memq (oref spec type) '(topic pullreq))))
- (oset spec type 'pullreq)
- (forge--insert-topics 'pullreqs
- (or heading "Pull requests")
- (forge--list-topics spec repo))))
-
-(defun forge--insert-pullreq-commits (pullreq &optional all)
- (cl-letf (((symbol-function #'magit-cancel-section) (lambda ())))
- (if all
- ;; Numeric pr ref, pr branch (if it exists) and api
- ;; pr range may be out of sync. Just show them all.
- (magit-insert-section-body
- (magit--insert-log nil
- (delq nil (list (concat "^" (or (oref pullreq base-rev)
- (concat (forge--get-remote) "/"
- (oref pullreq base-ref))))
- (forge--pullreq-ref pullreq)
- (forge--pullreq-branch-active pullreq)
- (and-let* ((branch (oref pullreq head-ref)))
- (and (magit-local-branch-p branch) branch))))
- (seq-uniq (cons "--graph" magit-buffer-log-args))))
- (when-let ((range (forge--pullreq-range pullreq)))
- (magit-insert-section-body
- (magit--insert-log nil range magit-buffer-log-args)
- (magit-make-margin-overlay nil t))))))
-
-;;; _
-(provide 'forge-pullreq)
-;;; forge-pullreq.el ends here
+++ /dev/null
-;;; forge-repo.el --- Repository support -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2024 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This file is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this file. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'forge)
-(require 'eieio)
-
-;;; Classes
-
-(defclass forge-repository (forge-object)
- ((closql-class-prefix :initform "forge-")
- (closql-class-suffix :initform "-repository")
- (closql-table :initform 'repository)
- (closql-primary-key :initform 'id)
- (issues-url-format :initform nil :allocation :class)
- (issue-url-format :initform nil :allocation :class)
- (issue-post-url-format :initform nil :allocation :class)
- (pullreqs-url-format :initform nil :allocation :class)
- (pullreq-url-format :initform nil :allocation :class)
- (pullreq-post-url-format :initform nil :allocation :class)
- (commit-url-format :initform nil :allocation :class)
- (branch-url-format :initform nil :allocation :class)
- (remote-url-format :initform nil :allocation :class)
- (create-issue-url-format :initform nil :allocation :class)
- (create-pullreq-url-format :initform nil :allocation :class)
- (pullreq-refspec :initform nil :allocation :class)
- (id :initform nil :initarg :id)
- (forge-id :initform nil :initarg :forge-id)
- (forge :initform nil :initarg :forge)
- (owner :initform nil :initarg :owner)
- (name :initform nil :initarg :name)
- (apihost :initform nil :initarg :apihost)
- (githost :initform nil :initarg :githost)
- (remote :initform nil :initarg :remote)
- (condition :initform :stub)
- (created :initform nil)
- (updated :initform nil)
- (pushed :initform nil)
- (parent :initform nil)
- (description :initform nil)
- (homepage :initform nil)
- (default-branch :initform nil)
- (archived-p :initform nil)
- (fork-p :initform nil)
- (locked-p :initform nil)
- (mirror-p :initform nil)
- (private-p :initform nil)
- (issues-p :initform t)
- (wiki-p :initform nil)
- (stars :initform nil)
- (watchers :initform nil)
- (assignees :closql-table assignee)
- (forks :closql-table fork)
- (issues :closql-class forge-issue)
- (labels :closql-table label)
- (pullreqs :closql-class forge-pullreq)
- (revnotes :closql-class forge-revnote)
- (selective-p :initform nil)
- (worktree :initform nil)
- (milestones :closql-table milestone)
- (issues-until :initform nil)
- (pullreqs-until :initform nil))
- :abstract t)
-
-(defclass forge-unusedapi-repository (forge-repository) () :abstract t)
-
-(defclass forge-noapi-repository (forge-repository) () :abstract t)
-
-(cl-defmethod slot-missing ((object forge-repository)
- slot-name operation &optional _new-value)
- (if (and (eq operation 'oref)
- (eq slot-name 'slug))
- (concat (oref object owner) "/"
- (oref object name))
- (cl-call-next-method)))
-
-;;; Query
-;;;; Get
-
-(defvar-local forge-buffer-repository nil)
-(put 'forge-buffer-repository 'permanent-local t)
-
-(defvar-local forge-buffer-unassociated-p nil)
-
-(defconst forge--signal-no-entry '(:tracked :stub :insert!))
-
-(defun forge--get-remote (&optional warn ignore-variable)
- (let* ((remotes (magit-list-remotes))
- (config (and (not ignore-variable)
- (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/How-Forge-Detection-Works.html"))
- remote))
-
-(cl-defmethod forge-get-repository ((_(eql :id)) id)
- (closql-get (forge-db) (substring-no-properties id) 'forge-repository))
-
-(cl-defmethod forge-get-repository ((_(eql :dir)) dir)
- (let ((default-directory dir)
- (forge-buffer-repository nil)
- (forge-buffer-topic nil))
- (forge-get-repository :stub? nil 'notatpt)))
-
-(cl-defmethod forge-get-repository ((demand symbol) &optional remote notatpt)
- "Return the current forge repository.
-
-First check if `forge-buffer-repository', or if that is nil, then
-the repository for `forge-buffer-topic', satisfies DEMAND. If so,
-then return that repository.
-
-Otherwise return the repository for `default-directory', if that
-exists and satisfies DEMAND. If that fails too, then return nil
-or signal an error, depending on DEMAND."
- (or (and-let* ((repo (and (not notatpt)
- (forge-repository-at-point))))
- (forge-get-repository repo 'noerror demand))
- (and-let* ((repo (or (forge-buffer-repository)
- (and forge-buffer-topic
- (forge-get-repository forge-buffer-topic)))))
- (forge-get-repository repo 'noerror demand))
- (magit--with-refresh-cache
- (list default-directory 'forge-get-repository demand)
- (if (not (magit-gitdir))
- (when (memq demand forge--signal-no-entry)
- (error
- "Cannot determine Forge repository outside of Git repository"))
- (unless remote
- (setq remote (forge--get-remote 'warn)))
- (if-let ((url (and remote
- (magit-git-string "remote" "get-url" remote))))
- (and-let* ((repo (forge-get-repository url remote demand)))
- (progn ; work around debbugs#31840
- (oset repo worktree (magit-toplevel))
- repo))
- (when (memq demand forge--signal-no-entry)
- (error
- "Cannot determine forge repository. %s\nSee %s."
- (cond (remote (format "No url configured for %S." remote))
- ((and-let* ((config (magit-get "forge.remote")))
- (format "Value of `forge.remote' is %S but %s"
- config "that remote does not exist.")))
- ((magit-list-remotes) "Cannot decide on remote to use.")
- (t "No remote configured."))
- "https://magit.vc/manual/forge/How-Forge-Detection-Works.html"
- )))))))
-
-(cl-defmethod forge-get-repository ((url string) &optional remote demand)
- "Return the repository at URL."
- (if-let ((parts (forge--split-forge-url url)))
- (forge-get-repository parts remote (or demand :known?))
- (when (memq demand forge--signal-no-entry)
- (error "Cannot determine forge repository. %s isn't a forge URL. %s"
- url "You might have to customize `forge-alist'."))))
-
-(cl-defmethod forge-get-repository (((host owner name) list)
- &optional remote demand)
- "((HOST OWNER NAME) &optional REMOTE DEMAND)
-
-Return the repository identified by HOST, OWNER and NAME.
-See `forge-alist' for valid Git hosts."
- (setq host (substring-no-properties host))
- (setq owner (substring-no-properties owner))
- (setq name (substring-no-properties name))
- (unless (memq demand '( :tracked :tracked?
- :known? :insert! :valid?
- :stub :stub?))
- (if-let ((new (pcase demand
- ('t :tracked)
- ('full :tracked?)
- ('nil :known?)
- ('create :insert!)
- ('stub :stub)
- ('maybe :stub?))))
- (progn
- (message "Obsolete value for `%s's DEMAND: `%s'; use `%s' instead"
- 'forge-get-repository demand new)
- (setq demand new))
- (error "Unknown value for `%s's DEMAND: `%s'"
- 'forge-get-repository demand)))
- (if-let ((spec (forge--get-forge-host host t)))
- (pcase-let ((`(,githost ,apihost ,webhost ,class) spec))
- ;; The `webhost' is used to identify the corresponding forge.
- ;; For that reason it is stored in the `forge' slot. The id
- ;; stored in the `id' slot also derives from that value.
- (let* ((row (car (forge-sql [:select * :from repository
- :where (and (= forge $s1)
- (= owner $s2)
- (= name $s3))]
- webhost owner name)))
- (obj (and row (closql--remake-instance class (forge-db) row))))
- ;; Synchronize the object with the entry from `forge-alist'.
- ;; This only has an effect if the entry was modified, which
- ;; should rarely, if ever, happen. Avoid confusion, by not
- ;; mentioning this detail in any docstring.
- (when obj
- (oset obj apihost apihost)
- (oset obj githost githost)
- (oset obj remote remote))
- (pcase (list demand (and obj (eq (oref obj condition) :tracked)))
- (`(:tracked? nil) (setq obj nil))
- (`(:tracked nil)
- (error "Cannot use `%s' in %S yet.\n%s"
- this-command (magit-toplevel)
- "Use `M-x forge-add-repository' before trying again.")))
- (when (and (memq demand '(:insert! :valid? :stub :stub?))
- (not obj))
- (pcase-let ((`(,id . ,forge-id)
- (forge--repository-ids
- class webhost owner name
- (memq demand '(:stub :stub?))
- (eq demand :valid?))))
- (if (not id)
- ;; `:valid?' was used and it turned out it is not.
- (setq obj nil)
- ;; The repo might have been renamed on the forge. #188
- (unless (setq obj (forge-get-repository :id id))
- (setq obj (funcall class
- :id id
- :forge-id forge-id
- :forge webhost
- :owner owner
- :name name
- :apihost apihost
- :githost githost
- :remote remote))
- (when (eq demand :insert!)
- (closql-insert (forge-db) obj)
- (oset obj condition :known))))))
- obj))
- (when (memq demand forge--signal-no-entry)
- (error "Cannot determine forge repository. No entry for %S in %s"
- host 'forge-alist))))
-
-(cl-defmethod forge-get-repository ((repo forge-repository)
- &optional noerror demand)
- (setq noerror (and noerror t))
- (with-slots (condition slug) repo
- (cl-symbol-macrolet
- ((err (error "Requested %s for %s, but is %s" demand slug condition))
- (key (list (oref repo forge)
- (oref repo owner)
- (oref repo name)))
- (ins (forge-get-repository key nil :insert!))
- (set (forge-get-repository key nil :valid?)))
- (pcase-exhaustive (list demand condition noerror)
- (`(nil ,_ ,_) repo)
- (`(:tracked? :tracked ,_) repo)
- (`(:tracked? ,_ ,_) nil)
- (`(:tracked :tracked ,_) repo)
- (`(:tracked ,_ t) nil)
- (`(:tracked ,_ nil) err)
- (`(:known? ,(or :tracked :known) ,_) repo)
- (`(:known? ,_ ,_) nil)
- (`(:insert! ,(or :tracked :known) ,_) repo)
- (`(:insert! ,_ ,_) ins)
- (`(:valid? ,(or :tracked :known) ,_) repo)
- (`(:valid? ,_ ,_) set)
- (`(:stub? ,_ ,_) repo)
- (`(:stub ,_ ,_) repo)))))
-
-(cl-defmethod forge-get-repository ((_ null) &optional noerror demand)
- (if (and (memq demand '(:insert! :tracked :stub))
- (not noerror))
- (error "(Maybe repository) is nil; `%s' not satisfied" demand)
- nil))
-
-(defun forge--get-repository:tracked? ()
- (forge-get-repository :tracked?))
-
-(defun forge-repository-at-point (&optional demand)
- "Return the repository at point.
-If there is no such repository and DEMAND is non-nil, then signal
-an error."
- (or (magit-section-value-if 'forge-repo)
- (and-let* ((topic (forge-topic-at-point)))
- (forge-get-repository topic))
- (and (derived-mode-p 'forge-repository-list-mode)
- (and-let* ((id (tabulated-list-get-id)))
- (forge-get-repository :id id)))
- (and demand (user-error "No repository at point"))))
-
-(defun forge--repo-for-thingatpt ()
- (or (magit-section-value-if 'forge-repo)
- (and-let* ((topic (magit-section-value-if '(issue pullreq))))
- (forge-get-repository topic))
- (and (not forge-buffer-unassociated-p)
- (or (forge-buffer-repository)
- (forge-get-repository :known? nil 'notatpt)))))
-
-(defun forge-buffer-repository ()
- (and-let* ((id forge-buffer-repository))
- (forge-get-repository :id id)))
-
-(defun forge-set-buffer-repository ()
- "Initialize the value of variable `forge-buffer-repository'."
- (unless forge-buffer-repository
- (and-let* ((repo (forge-get-repository :known?)))
- (setq forge-buffer-repository (oref repo id)))))
-
-(add-hook 'magit-mode-hook #'forge-set-buffer-repository)
-
-(defun forge-get-worktree (repo)
- "Validate, remember and return a worktree for REPO.
-If `default-directory' is within one of REPO's worktrees, record that
-location in its `worktree' slot and return it. Otherwise, if a worktree
-has been recorded before, validate that. If it still is a worktree of
-REPO, return it, else set the slot to nil and return nil."
- (if-let (((forge-repository-equal
- repo (forge-get-repository :dir default-directory)))
- (current-tree (magit-toplevel)))
- (oset repo worktree current-tree)
- (and-let* ((saved-tree (oref repo worktree)))
- (and (file-accessible-directory-p saved-tree)
- (if (forge-repository-equal
- repo (forge-get-repository :dir saved-tree))
- saved-tree
- (oset repo worktree nil))))))
-
-;;;; List
-
-(defun forge--ls-repos ()
- (mapcar (let ((db (forge-db)))
- (lambda (row)
- (closql--remake-instance 'forge-repository db row)))
- (forge-sql [:select * :from repository
- :order-by [(asc owner) (asc name)]])))
-
-(defun forge--ls-owned-repos ()
- (mapcar (let ((db (forge-db)))
- (lambda (row)
- (closql--remake-instance 'forge-repository db row)))
- (forge-sql [:select * :from repository
- :where (and (in owner $v1)
- (not (in name $v2)))
- :order-by [(asc owner) (asc name)]]
- (vconcat (mapcar #'car forge-owned-accounts))
- (vconcat forge-owned-ignored))))
-
-;;; Identity
-
-(defun forge-repository-equal (repo1 repo2)
- "Return t if REPO1 and REPO2 are the same repository.
-REPO1 and/or REPO2 may also be nil, in which case return nil."
- (and repo1 repo2
- (or (equal (oref repo1 id) (oref repo2 id))
- (and (equal (oref repo1 githost) (oref repo2 githost))
- (equal (oref repo1 owner) (oref repo2 owner))
- (equal (oref repo1 name) (oref repo2 name))))))
-
-(cl-defmethod forge--repository-ids ((class (subclass forge-repository))
- host owner name &optional stub noerror)
- "Return (OUR-ID . THEIR-ID) of the specified repository.
-If optional STUB is non-nil, then the IDs are not guaranteed to
-be unique. Otherwise this method has to make an API request to
-retrieve THEIR-ID, the repository's ID on the forge. In that
-case OUR-ID derives from THEIR-ID and is unique across all
-forges and hosts."
- (pcase-let* ((`(,_githost ,apihost ,id ,_class)
- (forge--get-forge-host host t))
- (path (format "%s/%s" owner name))
- (their-id (and (not stub)
- (ghub-repository-id
- owner name
- :host apihost
- :auth 'forge
- :forge (forge--ghub-type-symbol class)
- :noerror noerror))))
- (and (or stub their-id (not noerror))
- (cons (base64-encode-string
- (format "%s:%s" id
- (cond (stub path)
- ((eq class 'forge-github-repository)
- ;; This is base64 encoded, according to
- ;; https://docs.github.com/en/graphql/
- ;; reference/scalars#id. Unfortunately
- ;; that is not always true. E.g.,
- ;; https://github.com/dit7ya/roamex.
- (condition-case nil
- (base64-decode-string their-id)
- (error their-id)))
- (t their-id)))
- t)
- (or their-id path)))))
-
-(cl-defmethod forge--repository-ids ((_class (subclass forge-noapi-repository))
- host owner name &optional _stub _noerror)
- (let ((their-id (if owner (concat owner "/" name) name)))
- (cons (base64-encode-string
- (format "%s:%s"
- (nth 3 (forge--get-forge-host host t))
- their-id)
- t)
- their-id)))
-
-;;; Read
-
-(defun forge-read-repository (prompt)
- (let ((choice (magit-completing-read
- prompt
- (mapcar (pcase-lambda (`(,host ,owner ,name))
- (format "%s/%s @%s" owner name host))
- (forge-sql [:select [githost owner name]
- :from repository]))
- nil t nil nil
- (and-let* ((default (forge-get-repository :stub?)))
- (format "%s/%s @%s"
- (oref default owner)
- (oref default name)
- (oref default githost))))))
- (save-match-data
- (if (string-match "\\`\\(.+\\)/\\([^/]+\\) @\\(.+\\)\\'" choice)
- (forge-get-repository (list (match-string 3 choice)
- (match-string 1 choice)
- (match-string 2 choice)))
- (error "BUG")))))
-
-(defun forge-read-host (prompt &optional class)
- (magit-completing-read
- prompt
- (if class
- (seq-keep (pcase-lambda (`(,githost ,_apihost ,_webhost ,c))
- (and (child-of-class-p c class) githost))
- forge-alist)
- (mapcar #'car forge-alist))
- nil t))
-
-;;; Miscellaneous
-
-(defun forge--as-githost (host)
- (or (car (car (cl-member host forge-alist :test #'equal :key #'car)))
- (car (car (cl-member host forge-alist :test #'equal :key #'cadr)))
- (car (car (cl-member host forge-alist :test #'equal :key #'caddr)))
- (user-error "Cannot determine githost for %S" host)))
-
-(defun forge--as-apihost (host)
- (or (cadr (car (cl-member host forge-alist :test #'equal :key #'cadr)))
- (cadr (car (cl-member host forge-alist :test #'equal :key #'car)))
- (cadr (car (cl-member host forge-alist :test #'equal :key #'caddr)))
- (user-error "Cannot determine apihost for %S" host)))
-
-(cl-defmethod forge--format ((repo forge-repository) format-or-slot &optional spec)
- (pcase-let* (((eieio (forge webhost) owner name) repo)
- (path (if owner (concat owner "/" name) name)))
- (format-spec
- (let ((format (if (symbolp format-or-slot)
- (eieio-oref repo format-or-slot)
- format-or-slot)))
- (if (member webhost ghub-insecure-hosts)
- (replace-regexp-in-string "\\`https://" "http://" format t t)
- format))
- `(,@spec
- (?h . ,webhost)
- (?o . ,owner)
- (?n . ,name)
- (?p . ,path)
- (?P . ,(string-replace "/" "%2F" path))))))
-
-(defun forge--set-field-callback (topic)
- (lambda (&rest _)
- (forge--pull-topic
- (forge-get-repository topic)
- topic
- :callback (lambda ()
- (forge-refresh-buffer)
- (when (transient-active-prefix
- '(forge-topic-menu
- forge-topics-menu
- forge-notifications-menu))
- (transient--refresh-transient))))))
-
-(defvar forge--mode-line-buffer nil)
-
-(defun forge--msg (repo echo done format &rest args)
- (let ((msg (apply #'format format args)))
- (when repo
- (setq msg (string-replace
- "REPO"
- (concat (oref repo owner) "/" (oref repo name))
- msg)))
- (when (and echo msg)
- (message "%s%s" msg (if done "...done" "...")))
- (when (buffer-live-p forge--mode-line-buffer)
- (with-current-buffer forge--mode-line-buffer
- (setq mode-line-process
- (if done
- nil
- (concat " " (propertize msg 'font-lock-face
- 'magit-mode-line-process)))))
- (force-mode-line-update t))))
-
-(cl-defmethod ghub--host ((repo forge-repository))
- (cl-call-next-method (forge--ghub-type-symbol (eieio-object-class repo))))
-
-(cl-defmethod ghub--username ((repo forge-repository))
- (let ((default-directory default-directory))
- (unless (forge-repository-equal (forge-get-repository :stub?) repo)
- (when-let ((worktree (forge-get-worktree repo)))
- (setq default-directory worktree)))
- (cl-call-next-method (oref repo apihost)
- (forge--ghub-type-symbol (eieio-object-class repo)))))
-
-(defun forge--ghub-type-symbol (class)
- (pcase-exhaustive class
- ;; This package does not define a `forge-gitlab-http-repository'
- ;; class, but we used to suggest at #9 that users define such a class
- ;; if they must connect to a Gitlab instance that uses http instead
- ;; of https. Doing that isn't necessary anymore, but we have to keep
- ;; supporting it here. It is now sufficient to add an entry to
- ;; `ghub-insecure-hosts'.
- ((or 'forge-gitlab-repository 'forge-gitlab-http-repository) 'gitlab)
- ('forge-github-repository 'github)
- ('forge-gitea-repository 'gitea)
- ('forge-gogs-repository 'gogs)
- ('forge-bitbucket-repository 'bitbucket)))
-
-;;; _
-(provide 'forge-repo)
-;;; forge-repo.el ends here
+++ /dev/null
-;;; forge-repos.el --- List repositories -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2024 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This file is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this file. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'hl-line)
-
-(require 'forge-repo)
-(require 'forge-tablist)
-
-(defvar x-stretch-cursor)
-
-;;; Options
-
-(defcustom forge-repository-list-mode-hook '(hl-line-mode)
- "Hook run after entering Forge-Repository-List mode."
- :package-version '(forge . "0.4.0")
- :group 'forge
- :type 'hook
- :options '(hl-line-mode))
-
-(defcustom forge-repository-list-columns
- '(("Owner" owner 20 t nil)
- ("Name" name 20 t nil)
- ("T" forge-format-repo-condition 1 t nil)
- ("S" forge-format-repo-selective 1 t nil)
- ("Worktree" worktree 99 t nil))
- "List of columns displayed when listing repositories.
-
-Each element has the form (HEADER SOURCE WIDTH SORT PROPS).
-
-HEADER is the string displayed in the header. WIDTH is the width
-of the column. SOURCE is used to get the value, it has to be the
-name of a slot of `forge-repository' or a function that takes
-such an object as argument. SORT is a boolean or a function used
-to sort by this column. Supported PROPS include `:right-align'
-and `:pad-right'."
- :package-version '(forge . "0.4.0")
- :group 'forge
- :type forge--tablist-columns-type)
-
-;;; Mode
-
-(defvar-keymap forge-repository-list-mode-map
- :doc "Local keymap for Forge-Repository-List mode buffers."
- :parent (make-composed-keymap forge-common-map tabulated-list-mode-map)
- "n" #'forge-dispatch
- "RET" #'forge-visit-this-repository
- "<return>" #'forge-visit-this-repository
- "o" #'forge-browse-this-repository
- "<remap> <forge--list-menu>" #'forge-repositories-menu)
-
-(defvar-local forge--buffer-list-filter nil)
-
-(defvar forge-repository-list-buffer-name "*forge-repositories*"
- "Buffer name to use for displaying lists of repositories.")
-
-(defvar forge-repository-list-mode-name
- '((:eval (capitalize
- (concat (if forge--buffer-list-filter
- (format "%s " forge--buffer-list-filter)
- "")
- "repositories"))))
- "Information shown in the mode-line for `forge-repository-list-mode'.
-Must be set before `forge-list' is loaded.")
-
-(define-derived-mode forge-repository-list-mode tabulated-list-mode
- forge-repository-list-mode-name
- "Major mode for browsing a list of repositories."
- :interactive nil
- (setq-local x-stretch-cursor nil)
- (setq tabulated-list-padding 0)
- (setq tabulated-list-sort-key (cons "Owner" nil)))
-
-(defun forge-repository-list-setup (filter fn)
- (let ((buffer (get-buffer-create forge-repository-list-buffer-name)))
- (with-current-buffer buffer
- (setq default-directory "/")
- (setq forge--tabulated-list-columns forge-repository-list-columns)
- (setq forge--tabulated-list-query fn)
- (cl-letf (((symbol-function #'tabulated-list-revert) #'ignore)) ; see #229
- (forge-repository-list-mode))
- (setq forge--buffer-list-filter filter)
- (forge--tablist-refresh)
- (add-hook 'tabulated-list-revert-hook #'forge--tablist-refresh nil t)
- (tabulated-list-print)
- (when hl-line-mode
- (hl-line-highlight)))
- (switch-to-buffer buffer)))
-
-(defun forge-format-repo-condition (repo)
- "Return a character representing the value of REPO's `condition' slot."
- (pcase-exhaustive (oref repo condition)
- (:tracked "*")
- (:known " ")
- (:stub (propertize "s" 'face 'warning))))
-
-(defun forge-format-repo-selective (repo)
- "Return a character representing the value of REPO's `selective-p' slot."
- (pcase-exhaustive (oref repo selective-p)
- ('t "*")
- ('nil " ")))
-
-;;; Commands
-;;;; Menu
-
-;;;###autoload(autoload 'forge-repositories-menu "forge-repos" nil t)
-(transient-define-prefix forge-repositories-menu ()
- "Control list of repositories displayed in the current buffer."
- :transient-suffix t
- :transient-non-suffix #'transient--do-call
- :transient-switch-frame nil
- :refresh-suffixes t
- :environment #'forge--menu-environment
- :column-widths forge--topic-menus-column-widths
- [:hide always ("q" forge-menu-quit-list)]
- [forge--topic-menus-group
- forge--lists-group
- ["Filter"
- ("o" "owned" forge-list-owned-repositories
- :if-nil forge--buffer-list-filter)
- ("o" "owned" forge-list-repositories
- :face forge-suffix-active
- :if-non-nil forge--buffer-list-filter
- :inapt-if-mode nil)]]
- (interactive)
- (unless (derived-mode-p 'forge-repository-list-mode)
- (if-let ((buffer (get-buffer forge-repository-list-buffer-name)))
- (switch-to-buffer buffer)
- (forge-list-repositories)))
- (transient-setup 'forge-repositories-menu))
-
-(transient-augment-suffix forge-repositories-menu
- :transient #'transient--do-replace
- :if-mode 'forge-repository-list-mode
- :inapt-if (lambda () (eq (oref transient--prefix command) 'forge-repositories-menu))
- :inapt-face 'forge-suffix-active)
-
-;;;; List
-
-(defclass forge--repo-list-command (transient-suffix)
- ((type :initarg :type :initform nil)
- (filter :initarg :filter :initform nil)
- (global :initarg :global :initform nil)))
-
-;;;###autoload(autoload 'forge-list-repositories "forge-repos" nil t)
-(transient-define-suffix forge-list-repositories ()
- "List known repositories in a separate buffer.
-Here \"known\" means that an entry exists in the local database."
- :class 'forge--repo-list-command :type 'repo :global t
- :inapt-if-mode 'forge-repository-list-mode
- :inapt-face 'forge-suffix-active
- (declare (interactive-only nil))
- (interactive)
- (forge-repository-list-setup nil #'forge--ls-repos)
- (transient-setup 'forge-repositories-menu))
-
-;;;###autoload(autoload 'forge-list-owned-repositories "forge-repos" nil t)
-(transient-define-suffix forge-list-owned-repositories ()
- "List your own known repositories in a separate buffer.
-Here \"known\" means that an entry exists in the local database
-and options `forge-owned-accounts' and `forge-owned-ignored'
-controls which repositories are considered to be owned by you.
-Only Github is supported for now."
- :class 'forge--repo-list-command :type 'repo :filter 'owned :global t
- (interactive)
- (forge-repository-list-setup 'owned #'forge--ls-owned-repos)
- (transient-setup 'forge-repositories-menu))
-
-;;; _
-(provide 'forge-repos)
-;;; forge-repos.el ends here
+++ /dev/null
-;;; forge-revnote.el --- Revnote support -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2024 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This file is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this file. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'forge)
-(require 'forge-post)
-(require 'forge-topic)
-
-;;; Class
-
-(defclass forge-revnote (forge-topic)
- ((closql-table :initform 'revnote)
- (closql-primary-key :initform 'id)
- ;; (closql-order-by :initform [(desc number)])
- (closql-foreign-key :initform 'repository)
- (closql-class-prefix :initform "forge-")
- (id :initarg :id)
- (repository :initarg :repository)
- (commit :initarg :commit)
- (file :initarg :file)
- (line :initarg :line)
- (author :initarg :author)
- (body :initarg :body)))
-
-;;; _
-(provide 'forge-revnote)
-;;; forge-revnote.el ends here
+++ /dev/null
-;;; forge-semi.el --- Support for semi-forges -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2024 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This file is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this file. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'forge)
-
-;;; Classes
-
-(defclass forge-gitweb-repository (forge-noapi-repository)
- ((commit-url-format :initform "https://%h/gitweb/?p=%P.git;a=commitdiff;h=%r")
- (branch-url-format :initform "https://%h/gitweb/?p=%P.git;a=log;h=refs/heads/%r")
- (remote-url-format :initform "https://%h/gitweb/?p=%P.git;a=summary"))
- "Gitweb from https://git-scm.com/docs/gitweb.")
-
-(defclass forge-cgit-repository (forge-noapi-repository)
- ((commit-url-format :initform "https://%h/%p.git/commit/?id=%r")
- (branch-url-format :initform "https://%h/%p.git/log/?h=%r")
- (remote-url-format :initform "https://%h/%p.git/about"))
- "Cgit from https://git.zx2c4.com/cgit/about.
-Different hosts use different url schemata, so we need multiple
-classes. See their definitions in \"forge-semi.el\".")
-
-(defclass forge-cgit*-repository (forge-cgit-repository)
- ((commit-url-format :initform "https://%h/cgit/%p.git/commit/?id=%r")
- (branch-url-format :initform "https://%h/cgit/%p.git/log/?h=%r")
- (remote-url-format :initform "https://%h/cgit/%p.git/about"))
- "Cgit from https://git.zx2c4.com/cgit/about.
-Different hosts use different url schemata, so we need multiple
-classes. See their definitions in \"forge-semi.el\".")
-
-(defclass forge-cgit**-repository (forge-cgit-repository)
- ((commit-url-format :initform "https://%h/cgit/%n.git/commit/?id=%r")
- (branch-url-format :initform "https://%h/cgit/%n.git/log/?h=%r")
- (remote-url-format :initform "https://%h/cgit/%n.git/about"))
- "Cgit from https://git.zx2c4.com/cgit/about.
-Different hosts use different url schemata, so we need multiple
-classes. See their definitions in \"forge-semi.el\".")
-
-(defclass forge-repoorcz-repository (forge-cgit-repository)
- ((commit-url-format :initform "https://%h/%p.git/commit/%r")
- (branch-url-format :initform "https://%h/%p.git/log/%r")
- (remote-url-format :initform "https://%h/%p.git"))
- "Cgit fork used on https://repo.or.cz/cgit.git.
-Different hosts use different url schemata, so we need multiple
-classes. See their definitions in \"forge-semi.el\".")
-
-(defclass forge-stagit-repository (forge-noapi-repository)
- ((commit-url-format :initform "https://%h/%n/commit/%r.html")
- (branch-url-format :initform "https://%h/%n/refs.html")
- (remote-url-format :initform "https://%h/%n/file/README.html"))
- "Stagit from https://codemadness.org/git/stagit/file/README.html.
-Only the history of \"master\" can be shown, so this links to the
-list of refs instead of the log of the specified branch.")
-
-(defclass forge-srht-repository (forge-noapi-repository)
- ((commit-url-format :initform "https://%h/~%o/%n/commit/%r")
- (branch-url-format :initform "https://%h/~%o/%n/log/%r")
- (remote-url-format :initform "https://%h/~%o/%n"))
- "See https://meta.sr.ht.")
-
-;;; _
-(provide 'forge-semi)
-;;; forge-semi.el ends here
+++ /dev/null
-;;; forge-tablist.el --- Tabulated-list interface -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2024 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This file is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this file. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'tabulated-list)
-
-(require 'forge)
-
-(defconst forge--tablist-columns-type
- '(repeat
- (list :tag "Column"
- (string :tag "Header Label")
- (choice :tag "Value source"
- function
- (symbol :tag "Object slot"))
- (integer :tag "Column Width")
- (choice :tag "Sort predicate"
- (const :tag "Don't sort" nil)
- (const :tag "Default" t)
- function)
- (plist :tag "Properties"
- :key-type (choice :tag "Property"
- (const :right-align)
- (const :pad-right)
- symbol)
- :value-type (sexp :tag "Value")))))
-
-(defvar-local forge--tabulated-list-columns nil)
-(put 'forge--tabulated-list-columns 'permanent-local t)
-
-(defvar-local forge--tabulated-list-query nil)
-(put 'forge--tabulated-list-query 'permanent-local t)
-
-(defun forge--tablist-refresh ()
- (setq tabulated-list-format
- (vconcat (mapcar (pcase-lambda (`(,name ,_get ,width ,sort ,props))
- `(,name ,width ,sort . ,props))
- forge--tabulated-list-columns)))
- (tabulated-list-init-header)
- (setq tabulated-list-entries
- (mapcar
- (lambda (obj)
- (list (oref obj id)
- (vconcat
- (mapcar (pcase-lambda (`(,_name ,get ,_width ,_sort ,_props))
- (let ((val (cond
- ((functionp get)
- (funcall get obj))
- ((eq (car-safe get) 'repository)
- (eieio-oref (forge-get-repository obj)
- (cadr get)))
- ((eieio-oref obj get)))))
- (cond ((stringp val) val)
- ((null val) "")
- ((format "%s" val)))))
- forge--tabulated-list-columns))))
- (funcall forge--tabulated-list-query))))
-
-;;; _
-(provide 'forge-tablist)
-;;; forge-tablist.el ends here
+++ /dev/null
-;;; forge-topic.el --- Topics support -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2024 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This file is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this file. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'bug-reference)
-(require 'eieio-custom)
-(require 'markdown-mode)
-(require 'parse-time)
-(require 'yaml)
-
-(require 'forge)
-(require 'forge-post)
-
-(defvar bug-reference-auto-setup-functions)
-
-;;; Options
-
-(defcustom forge-limit-topic-choices t
- "Whether to initially limit completion candidates to active topics."
- :package-version '(forge . "0.4.0")
- :group 'forge
- :type 'boolean)
-
-(defcustom forge-post-heading-format "%a %C\n"
- "Format for post headings in topic view.
-
-The following %-sequences are supported:
-
-`%a' The forge nickname of the author.
-`%c' The absolute creation date.
-`%C' The relative creation date."
- :package-version '(forge . "0.1.0")
- :group 'forge
- :type 'string)
-
-(defcustom forge-post-fill-region t
- "Whether to call `fill-region' before displaying forge posts."
- :package-version '(forge . "0.1.0")
- :group 'forge
- :type 'boolean)
-
-(defcustom forge-topic-repository-slug-width 28
- "Width of repository slugs (i.e., \"OWNER/NAME\")."
- :package-version '(forge . "0.4.0")
- :group 'forge
- :type 'natnum)
-
-(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 forge-format-avatar-function nil
- "Function used to insert avatars in certain locations.
-This is experimental and intended for users who wish to
-implement such a function themselves. See #447.")
-
-;;; Faces
-;;;; Common
-
-(defface forge-dimmed '((t :foreground "#93a1a1"))
- "Parent face or faces used for text that shouldn't stand out.
-
-This face is not directly, instead several faces inherit from it
-either directly or via an intermediate face. This face should
-only specify the `:foreground' attribute, which is why this face
-does not inherit from `magit-dimmed'."
- :group 'forge-faces)
-
-(defface forge-topic-header-line
- '((t :inherit magit-header-line :foreground reset))
- "Face for the `header-line' in `forge-topic-mode' buffers."
- :group 'forge-faces)
-
-;;;; Topic and Notification Slugs
-
-(defface forge-topic-slug-open
- '((t :inherit forge-dimmed))
- "Face uses for slugs of open topics."
- :group 'forge-faces)
-
-(defface forge-topic-slug-completed
- '((t :inherit forge-dimmed))
- "Face used for slugs of completed topics."
- :group 'forge-faces)
-
-(defface forge-topic-slug-unplanned
- '((t :inherit forge-dimmed :strike-through t))
- "Face used for slugs of unplanned topics.
-E.g., for issues closes as \"unplanned\" and pull-requests that
-were closed without being merged."
- :group 'forge-faces)
-
-(defface forge-topic-slug-saved
- '((t :foreground "orange"))
- "Face used for slugs of topics with saved notifications."
- :group 'forge-faces)
-
-(defface forge-topic-slug-unread
- '((t :weight bold))
- "Face used for slugs of topics with unread notifications."
- :group 'forge-faces)
-
-;;;; Topic and Notification Summaries
-;;;;; Notifications
-
-(defface forge-topic-unread
- '((t :weight bold
- :box (:line-width (-1 . -1) :style nil)))
- "Face used for summaries of entities with unread notifications.
-This face is always used together with, and takes preference over,
-a `forge-{issue,pullreq}-STATE' face and should not specify any
-attribute that is specified by any of those faces. Likewise those
-faces should not set `:weight' or `:slant'."
- :group 'forge-faces)
-
-(defface forge-topic-pending
- '((t :weight bold))
- "Face used for summaries of entities with open notifications.
-This face is always used together with, and takes preference over,
-a `forge-{issue,pullreq}-STATE' face and should not specify any
-attribute that is specified by any of those faces. Likewise those
-faces should not set `:weight' or `:slant'."
- :group 'forge-faces)
-
-(defface forge-topic-done
- '((t))
- "Face used for summaries of entities with no unread or open notification.
-This face is always used together with, and takes preference over,
-a `forge-{issue,pullreq}-STATE' face and should not specify any
-attribute that is specified by any of those faces. Likewise those
-faces should not set `:weight' or `:slant'."
- :group 'forge-faces)
-
-;;;;; Issues
-
-(defface forge-issue-open
- '((t))
- "Face used for summaries of open issues."
- :group 'forge-faces)
-
-(defface forge-issue-completed
- '((t :inherit forge-dimmed))
- "Face used for summaries of issues closed as completed."
- :group 'forge-faces)
-
-(defface forge-issue-unplanned
- '((t :inherit forge-dimmed :strike-through t))
- "Face used for summaries of issues closed as unplanned."
- :group 'forge-faces)
-
-;;;;; Pull-Requests
-
-(defface forge-pullreq-open
- '((t :foreground "LimeGreen"))
- "Face used for summaries of open pull-requests."
- :group 'forge-faces)
-
-(defface forge-pullreq-merged
- '((t :foreground "MediumPurple"))
- "Face used for summaries of merged pull-requests."
- :group 'forge-faces)
-
-(defface forge-pullreq-rejected
- '((t :foreground "MediumPurple" :strike-through t))
- "Face used for summaries of closed pull-requests, that weren't merged."
- :group 'forge-faces)
-
-(defface forge-pullreq-draft
- '((t :slant italic))
- "Face used for summaries of draft pull-requests.
-A face attribute should be used that is not already used by any
-`forge-topic-STATUS' or `forge-{issue,pullreq}-STATE' face."
- :group 'forge-faces)
-
-;;;; Labels
-
-(defface forge-topic-label
- '((t :inherit secondary-selection
- :box (:line-width (-1 . -1) :style released-button)))
- "Face used for topic labels, marks and milestones."
- :group 'forge-faces)
-
-;;;; Post Details
-
-(defface forge-post-author
- '((t :inherit bold))
- "Face used for post author in topic view."
- :group 'forge-faces)
-
-(defface forge-post-date
- '((t :inherit italic))
- "Face used for post date in topic view."
- :group 'forge-faces)
-
-;;; Class
-
-(defclass forge-topic (forge-post) () :abstract t)
-
-(cl-defmethod forge--object-id ((class (subclass forge-topic)) repo number)
- "Return the id for a CLASS object in REPO identified by id NUMBER."
- (base64-encode-string
- (encode-coding-string
- (format "%s:%s%s"
- (base64-decode-string (oref repo id))
- (substring (symbol-name class)
- (length (oref-default class closql-class-prefix)))
- number)
- 'utf-8)
- t))
-
-(cl-defmethod forge--object-id ((prefix string) number-or-id)
- (base64-encode-string
- (encode-coding-string
- (format "%s:%s"
- (base64-decode-string prefix)
- (if (numberp number-or-id)
- number-or-id
- ;; Currently every ID is base64 encoded. Unfortunately
- ;; we cannot use the IDs of Gitlab labels (see comment
- ;; in the respective `forge--update-labels' method),
- ;; and have to use their names, which are not encoded.
- (or (ignore-errors (base64-decode-string number-or-id))
- number-or-id)))
- 'utf-8)
- t))
-
-(cl-defmethod forge-topic-mark-read ((topic forge-topic))
- (when (eq (oref topic status) 'unread)
- (oset topic status 'pending)))
-
-(cl-defmethod forge--set-topic-marks ((_repo forge-repository) topic marks)
- (oset topic marks
- (mapcar #'car (forge-sql [:select id :from mark :where (in name $v1)]
- (vconcat marks))))
- (forge-refresh-buffer))
-
-;;; Query
-;;;; Get
-
-(cl-defmethod forge-get-parent ((topic forge-topic))
- (forge-get-repository topic))
-
-(cl-defmethod forge-get-repository ((topic forge-topic))
- (closql-get (forge-db)
- (oref topic repository)
- 'forge-repository))
-
-(cl-defmethod forge-get-topic ((topic forge-topic))
- topic)
-
-(cl-defmethod forge-get-topic ((repo forge-repository) number-or-id)
- (if (numberp number-or-id)
- (if (< number-or-id 0)
- (forge-get-pullreq repo (abs number-or-id))
- (or (forge-get-issue repo number-or-id)
- (forge-get-pullreq repo number-or-id)))
- (or (forge-get-issue number-or-id)
- (forge-get-pullreq number-or-id))))
-
-(cl-defmethod forge-get-topic ((number integer))
- (if (< number 0)
- (forge-get-pullreq (abs number))
- (or (forge-get-issue number)
- (forge-get-pullreq number))))
-
-(cl-defmethod forge-get-topic ((id string))
- (or (forge-get-issue id)
- (forge-get-pullreq id)))
-
-;;;; Current
-
-(defun forge-current-topic (&optional demand)
- "Return the topic at point or being visited.
-If there is no such topic and DEMAND is non-nil, then signal
-an error."
- (or (forge-topic-at-point)
- forge-buffer-topic
- (and demand (user-error "No current topic"))))
-
-(defun forge-topic-at-point (&optional demand)
- "Return the topic at point.
-If there is no such topic and DEMAND is non-nil, then signal
-an error."
- (or (thing-at-point 'forge-topic)
- (magit-section-value-if '(issue pullreq))
- (forge-get-pullreq :branch)
- (and demand (user-error "No topic at point"))))
-
-(put 'forge-topic 'thing-at-point #'forge-thingatpt--topic)
-(defun forge-thingatpt--topic ()
- (and-let* ((repo (forge--repo-for-thingatpt)))
- (and (thing-at-point-looking-at
- (if (forge-gitlab-repository--eieio-childp repo)
- "\\(?2:[#!]\\)\\(?1:[0-9]+\\)\\_>"
- "#\\([0-9]+\\)\\_>"))
- (funcall (if (equal (match-string 2) "!")
- #'forge-get-pullreq
- #'forge-get-topic)
- repo (string-to-number (match-string-no-properties 1))))))
-
-(defun forge-region-topics ()
- (magit-region-values '(issue pullreq)))
-
-;;;; List
-
-(defvar-local forge--buffer-topics-spec nil)
-(put 'forge--buffer-topics-spec 'permanent-local t)
-
-(defun forge--init-buffer-topics-spec ()
- (unless forge--buffer-topics-spec
- (setq forge--buffer-topics-spec
- (clone forge-status-buffer-default-topic-filters))))
-(add-hook 'magit-status-mode-hook #'forge--init-buffer-topics-spec)
-
-(defun forge--clone-buffer-topics-spec ()
- (forge--init-buffer-topics-spec)
- (clone forge--buffer-topics-spec))
-
-(defclass forge--topics-spec ()
- ((type :documentation "\
-Limit list based on topic type."
- :initarg :type
- :initform 'topic
- :type (member topic issue pullreq nil)
- :custom (choice
- (const topic)
- (const issue)
- (const pullreq)
- (const :tag "disable topic sections (nil)" nil)))
- (active :documentation "\
-Limit list to active topics.
-
-A topic is \"active\" if its state (public condition) is open and/or
-its status (private condition) is unread or pending.
-
-When this is t, then the value of the `state' and `status' slots are
-ignored."
- :initarg :active
- :initform t
- :type boolean
- :custom boolean)
- (state :documentation "\
-Limit list based on topic (public) state.
-
-State is the \"public condition\". I.e., is the topic still open?"
- :initarg :state
- :initform 'open
- :type (satisfies (lambda (val)
- (member val '(open
- (completed merged)
- (unplanned rejected)
- nil))))
- :custom (choice
- (const open)
- (const (completed merged))
- (const (unplanned rejected))
- (const :tag "all (nil)" nil)))
- (status :documentation "\
-Limit list based on topic (private) status.
-
-Status is the \"private condition\". I.e., have you decided yet
-that *you* are done with the topic, and have others made changes,
-which *you* have not seen yet?
-
-`inbox' means \"`unread' or `pending'\"."
- :initarg :status
- :initform nil
- :type (member inbox unread pending done nil)
- :custom (choice
- (const inbox)
- (const unread)
- (const pending)
- (const done)
- (const :tag "all (nil)" nil)))
- (updated :documentation "\
-Date when topic was last updated."
- :initarg :updated
- :initform nil
- :type (or string null))
- (milestone :documentation "\
-Limit list to topics assigned to given milestone."
- :initarg :milestone
- :initform nil
- :type (or string null)
- :custom string)
- (labels :documentation "\
-Limit list to topics with at least one of the given labels."
- :initarg :labels
- :initform nil
- :type (list-of string)
- :custom (repeat string))
- (marks :documentation "\
-Limit list to topics with at least one of the given marks.
-Marks are like labels, but they are private and local to the
-current Forge database."
- :initarg :marks
- :initform nil
- :type (list-of string)
- :custom (repeat string))
- (saved :documentation "Limit list to saved topics."
- :initarg :saved
- :initform nil
- :type boolean
- :custom boolean)
- (author :documentation "\
-Limit list to topics created by given user."
- :initarg :author
- :initform nil
- :label "Author (username)"
- :type (or string null)
- :custom string)
- (assignee :documentation "\
-Limit list to topics assigned to given user."
- :initarg :assignee
- :initform nil
- :label "Assignee (username)"
- :type (or string null)
- :custom string)
- (reviewer :documentation "\
-Limit list to topics for which a review by the given user was requested."
- :initarg :reviewer
- :initform nil
- :label "Reviewer (username)"
- :type (or string null)
- :custom string)
- (global :documentation "Whether to list topics for all repositories."
- :initarg :global
- :initform nil
- :type boolean)
- (order :documentation "Order in which topics are listed."
- :initarg :order
- :initform 'newest
- :type (member newest oldest recently-updated anciently-updated)
- :custom (choice (const newest)
- (const oldest)
- (const recently-updated)
- (const anciently-updated)))
- (limit :documentation "Number of topics to list at most."
- :initarg :limit
- :initform 200
- :type integer
- :custom natnum)
- (grouped :documentation "Whether to group topics by repository."
- :initarg :grouped
- :initform nil
- :type boolean
- :custom boolean)))
-
-(cl-defun forge--list-topics
- (&optional (spec forge--buffer-topics-spec)
- (repo (forge-get-repository :tracked?))
- (type (oref spec type)))
- (when (oref spec reviewer)
- (setq type 'pullreq))
- (if (eq type 'topic)
- (pcase-let ((`(,pred ,slot) (pcase (oref spec order)
- ('newest '(> number))
- ('oldest '(< number))
- ('recently-updated '(> updated))
- ('anciently-updated '(< updated)))))
- (cl-sort (nconc (forge--list-topics-1 spec repo 'issue)
- (forge--list-topics-1 spec repo 'pullreq))
- pred :key (lambda (obj) (eieio-oref obj slot))))
- (forge--list-topics-1 spec repo type)))
-
-(defun forge--list-topics-1 (spec repo type)
- (mapcar (apply-partially #'closql--remake-instance
- (if (eq type 'issue) 'forge-issue 'forge-pullreq)
- (forge-db))
- (forge-sql (forge--list-topics-2 spec repo type))))
-
-(defun forge--list-topics-2 (spec repo type)
- (pcase-let (((eieio active state status milestone labels marks
- saved author assignee reviewer global order limit)
- spec))
- (cond (active
- (setq state 'open)
- (setq status '(unread pending)))
- ((eq status 'inbox)
- (setq status '(unread pending))))
- `[:select :distinct topic:*
- :from [(as ,type topic)]
- ,@(cond
- (milestone
- `[:join milestone :on (= milestone:title ,milestone)]))
- ,@(cond
- ((not labels) nil)
- ((eq type 'issue)
- [:join issue-label :on (= issue-label:issue topic:id)
- :join label :on (= label:id issue-label:id)])
- ([:join pullreq-label :on (= pullreq-label:pullreq topic:id)
- :join label :on (= label:id pullreq-label:id)]))
- ,@(cond
- ((not marks) nil)
- ((eq type 'issue)
- [:join issue-mark :on (= issue-mark:issue topic:id)
- :join mark :on (= mark:id issue-mark:id)])
- ([:join pullreq-mark :on (= pullreq-mark:pullreq topic:id)
- :join mark :on (= mark:id pullreq-mark:id)]))
- ,@(cond
- ((not assignee) nil)
- ((eq type 'issue)
- [:join issue-assignee :on (= issue-assignee:issue topic:id)
- :join assignee :on (= assignee:id issue-assignee:id)])
- ([:join pullreq-assignee :on (= pullreq-assignee:pullreq topic:id)
- :join assignee :on (= assignee:id pullreq-assignee:id)]))
- ,@(cond
- (reviewer
- [:join (as pullreq-review-request r) :on (= r:pullreq topic:id)
- :join assignee :on (= assignee:id r:id)]))
- :where
- (and
- ,@(and (not global) repo `((= topic:repository ,(oref repo id))))
- ,@(cond
- ((and active state status)
- `((or (in topic:state ,(vconcat (ensure-list state)))
- (in topic:status ,(vconcat (ensure-list status))))))
- (`(,@(and state `((in topic:state ,(vconcat (ensure-list state)))))
- ,@(and status `((in topic:status ,(vconcat (ensure-list status))))))))
- ,@(and milestone '((= topic:milestone milestone:id)))
- ,@(and labels `((or ,@(mapcar (lambda (l) `(= label:name ,l)) labels))))
- ,@(and marks `((or ,@(mapcar (lambda (m) `(= mark:name ,m)) marks))))
- ,@(and saved '((= topic:saved-p 't)))
- ,@(and author `((= topic:author ,author)))
- ,@(and assignee `((= assignee:login ,assignee)))
- ,@(and reviewer `((= assignee:login ,reviewer))))
- :order-by [,(pcase order
- ('newest '(desc topic:number))
- ('oldest '(asc topic:number))
- ('recently-updated '(desc topic:updated))
- ('anciently-updated '(asc topic:updated)))]
- ,@(and limit `(:limit ,limit))]))
-
-;;; Read
-
-(defun forge-read-topic (prompt)
- "Read an active topic with completion using PROMPT.
-
-Open, unread and pending topics are considered active.
-Default to the current topic, even if it isn't active.
-
-\\<forge-read-topic-minibuffer-map>While completion is in \
-progress, \\[forge-read-topic-lift-limit] lifts the limit, extending
-the completion candidates to include all topics.
-
-If `forge-limit-topic-choices' is nil, then all candidates
-can be selected from the start."
- (forge--read-topic prompt
- #'forge-current-topic
- (forge--topics-spec :type 'topic :active t)
- (forge--topics-spec :type 'topic :active nil :state nil)))
-
-(defun forge--read-topic (prompt current active all)
- (let* ((current (funcall current))
- (repo (forge-get-repository (or current :tracked)))
- (default (and current (forge--format-topic-line current)))
- (alist (forge--topic-collection
- (forge--list-topics (if forge-limit-topic-choices active all)
- repo)))
- (choices (mapcar #'car alist))
- (choices (cond ((and forge-limit-topic-choices
- default
- (not (member default choices)))
- (push (cons default (oref current id)) alist)
- (cons default choices))
- (choices)))
- (choice
- (if forge-limit-topic-choices
- (minibuffer-with-setup-hook
- (lambda ()
- (use-local-map (make-composed-keymap
- forge-read-topic-minibuffer-map
- (current-local-map))))
- (magit-completing-read
- (substitute-command-keys
- (format "%s \\<%s> (\\[%s] for all)" prompt
- 'forge-read-topic-minibuffer-map
- 'forge-read-topic-lift-limit))
- (completion-table-dynamic
- (let (all-choices)
- (lambda (_string)
- (cond
- (all-choices)
- (forge-limit-topic-choices choices)
- (t
- (forge--replace-minibuffer-prompt (concat prompt ": "))
- (setq alist (forge--topic-collection
- (forge--list-topics all repo)))
- (setq all-choices (mapcar #'car alist)))))))
- nil t nil nil default))
- (magit-completing-read prompt choices nil t nil nil default))))
- (cdr (assoc choice alist))))
-
-(defun forge--topic-collection (topics)
- (mapcar (lambda (topic)
- (cons (forge--format-topic-line topic)
- (oref topic id)))
- topics))
-
-(defvar-keymap forge-read-topic-minibuffer-map
- "+" #'forge-read-topic-lift-limit)
-
-(defun forge-read-topic-lift-limit ()
- "No longer limit completion candidates to active topics."
- (interactive)
- (when (and (minibufferp)
- forge-limit-topic-choices)
- (setq-local forge-limit-topic-choices nil)
- (when (and (bound-and-true-p vertico-mode)
- (boundp 'vertico--input)
- (fboundp 'vertico--exhibit))
- (setq vertico--input t)
- (vertico--exhibit))))
-
-(defun forge--replace-minibuffer-prompt (prompt)
- (save-excursion
- (goto-char (point-min))
- (let ((inhibit-read-only t)
- (end (length prompt)))
- ;; (insert-and-inherit prompt) would discard all faces already
- ;; present in PROMPT, so instead we do it like `read_minibuf'.
- (put-text-property 0 end 'front-sticky t prompt)
- (put-text-property 0 end 'rear-nonsticky t prompt)
- (put-text-property 0 end 'field t prompt)
- (let ((props minibuffer-prompt-properties))
- (while props
- (let ((key (pop props))
- (val (pop props)))
- (if (eq key 'face)
- (add-face-text-property 0 end val t prompt)
- (put-text-property 0 end key val prompt)))))
- (insert prompt)
- (delete-region (point) (minibuffer-prompt-end)))))
-
-(defun forge-topic-completion-at-point ()
- (let ((bol (line-beginning-position))
- repo)
- (and (looking-back "[!#][0-9]*" bol)
- (or (not bug-reference-prog-mode)
- (nth 8 (syntax-ppss))) ; inside comment or string
- (setq repo (forge-get-repository :tracked))
- (looking-back (if (forge--childp repo 'forge-gitlab-repository)
- "\\(?3:[!#]\\)\\(?2:[0-9]*\\)"
- "#\\(?2:[0-9]*\\)")
- bol)
- (list (match-beginning 2)
- (match-end 0)
- (mapcar (lambda (row)
- (propertize (number-to-string (car row))
- :title (format " %s" (cadr row))))
- (if (forge--childp repo 'forge-gitlab-repository)
- (forge-sql [:select [number title]
- :from $i1
- :where (= repository $s2)
- :order-by [(desc updated)]]
- (if (equal (match-string 3) "#")
- 'issue
- 'pullreq)
- (oref repo id))
- (forge-sql [:select [number title updated]
- :from pullreq
- :where (= repository $s1)
- :union
- :select [number title updated]
- :from issue
- :where (= repository $s1)
- :order-by [(desc updated)]]
- (oref repo id))))
- :annotation-function (lambda (c) (get-text-property 0 :title c))))))
-
-(defun forge-read-topic-title (topic)
- (read-string "Title: " (oref topic title)))
-
-(defun forge-read-topic-milestone (&optional topic)
- (forge--completing-read
- "Milestone"
- (mapcar #'caddr (oref (forge-get-repository (or topic :tracked)) milestones))
- nil t
- (and topic (forge--format-topic-milestone topic))))
-
-(defun forge-read-topic-labels (&optional obj)
- (let ((crm-separator ","))
- (magit-completing-read-multiple
- "Labels: "
- (forge--format-labels (and obj (forge-get-repository obj)))
- nil t
- (and (forge-topic-p obj)
- (forge--format-labels obj crm-separator)))))
-
-(defun forge-read-topic-marks (&optional obj)
- (let ((crm-separator ","))
- (magit-completing-read-multiple
- "Marks: " (forge--format-marks) nil t
- (and (forge-topic-p obj)
- (forge--format-marks obj crm-separator)))))
-
-(defun forge-read-topic-assignees (&optional topic)
- (let* ((repo (forge-get-repository (or topic :tracked)))
- (value (and topic (oref topic assignees)))
- (choices (mapcar #'cadr (oref repo assignees)))
- (crm-separator ","))
- (magit-completing-read-multiple
- "Assignees: " choices nil
- (if (forge--childp repo 'forge-gitlab-repository)
- t ; Selecting something else would fail later on.
- 'confirm)
- (mapconcat #'cadr value ","))))
-
-(defun forge-read-topic-review-requests (&optional topic)
- (let* ((repo (forge-get-repository (or topic :tracked)))
- (value (and topic (oref topic review-requests)))
- (choices (mapcar #'cadr (oref repo assignees)))
- (crm-separator ","))
- (magit-completing-read-multiple
- "Request review from: " choices nil
- 'confirm
- (mapconcat #'cadr value ","))))
-
-(defun forge--completing-read ( prompt collection &optional
- predicate require-match initial-input
- hist def)
- ;; NOTE Only required until `magit-completing-read' has been
- ;; updated to allow empty input if require-match is t.
- (let ((reply (funcall magit-completing-read-function
- (concat prompt ": ")
- (if (and def (not (member def collection)))
- (cons def collection)
- collection)
- predicate
- require-match initial-input hist def)))
- (if (equal reply "")
- (if (and require-match (not (eq require-match t)))
- (user-error "Nothing selected")
- nil)
- reply)))
-
-;;; Format
-
-(cl-defmethod forge--format ((topic forge-topic) slot &optional spec)
- (forge--format (forge-get-repository topic) slot
- `(,@spec (?i . ,(oref topic number)))))
-
-(defun forge--format-topic-line (topic &optional width)
- (concat
- (and (or (and (derived-mode-p 'forge-notifications-mode)
- (eq forge-notifications-display-style 'flat))
- (and (derived-mode-p 'forge-topics-mode)
- (oref forge--buffer-topics-spec global)
- (not (oref forge--buffer-topics-spec grouped))))
- (concat (truncate-string-to-width
- (oref (forge-get-repository topic) slug)
- forge-topic-repository-slug-width
- nil ?\s t)
- " "))
- ;; MAYBE bring this back once we support discussions.
- ;; (cond (no-indicator nil)
- ;; ((forge-issue-p topic) (magit--propertize-face "I " 'magit-dimmed))
- ;; ((forge-pullreq-p topic) (magit--propertize-face "P " 'magit-dimmed))
- ;; (t (magit--propertize-face "* " 'error)))
- (string-pad (forge--format-topic-slug topic) (or width 5))
- " "
- (forge--format-topic-title topic)))
-
-(defun forge--format-topic-slug (topic)
- (with-slots (slug state status saved-p) topic
- (magit--propertize-face
- slug
- `(,@(and saved-p '(forge-topic-slug-saved))
- ,@(and (eq status 'unread) '(forge-topic-slug-unread))
- ,(pcase state
- ('open 'forge-topic-slug-open)
- ((or 'completed 'merged) 'forge-topic-slug-completed)
- ((or 'unplanned 'rejected) 'forge-topic-slug-unplanned))))))
-
-(defun forge--format-topic-refs (topic)
- (pcase-let
- (((eieio cross-repo-p base-repo base-ref head-repo head-ref) topic)
- (separator (magit--propertize-face ":" 'magit-dimmed))
- (deleted (magit--propertize-face "(deleted)" 'magit-dimmed)))
- (concat (if cross-repo-p
- (concat base-repo separator base-ref)
- base-ref)
- (magit--propertize-face "..." 'magit-dimmed)
- (if cross-repo-p
- (if (and head-repo head-ref)
- (concat head-repo separator head-ref)
- deleted)
- (or head-ref deleted)))))
-
-(defun forge--format-topic-draft (topic)
- (if (oref topic draft-p)
- (magit--propertize-face "yes" 'bold)
- (magit--propertize-face "no" 'magit-dimmed)))
-
-(defun forge--format-topic-saved (topic)
- (if (oref topic saved-p)
- (magit--propertize-face "yes" 'bold)
- (magit--propertize-face "no" 'magit-dimmed)))
-
-(defun forge--format-topic-title (topic)
- (with-slots (title status state) topic
- (magit-log-propertize-keywords
- nil
- (magit--propertize-face
- title
- `(,@(and (forge-pullreq-p topic)
- (oref topic draft-p)
- '(forge-pullreq-draft))
- ,(pcase status
- ('unread 'forge-topic-unread)
- ('pending 'forge-topic-pending)
- ('done 'forge-topic-done))
- ,(pcase (list (eieio-object-class topic) state)
- (`(forge-issue open) 'forge-issue-open)
- (`(forge-issue completed) 'forge-issue-completed)
- (`(forge-issue unplanned) 'forge-issue-unplanned)
- (`(forge-pullreq open) 'forge-pullreq-open)
- (`(forge-pullreq merged) 'forge-pullreq-merged)
- (`(forge-pullreq rejected) 'forge-pullreq-rejected)))))))
-
-(defun forge--format-topic-milestone (topic)
- (and-let* ((id (oref topic milestone))
- (str (caar (forge-sql [:select [title]
- :from milestone
- :where (= id $s1)]
- id))))
- (magit--propertize-face str 'forge-topic-label)))
-
-(defun forge--format-labels (&optional arg concat)
- (and-let*
- ((local t)
- (labels (cond
- ((eieio-object-p arg)
- (oref arg labels))
- ((forge-buffer-repository)
- (forge-sql-cdr `[:select label:* :from label :where
- ,(if arg
- '(and (= repository $s1)
- (in name $v2))
- '(= repository $s1))
- :order-by [(asc name)]]
- forge-buffer-repository
- (vconcat arg)))
- (t
- (setq local nil)
- (forge-sql `[:select :distinct name :from label
- ,@(and arg '(:where (in name $v1)))
- :order-by [(asc name)]]
- (vconcat arg)))))
- (format (if local
- (pcase-lambda (`(,_id ,name ,color ,_description))
- (let* ((background (forge--sanitize-color color))
- (foreground (readable-foreground-color background)))
- (magit--propertize-face
- name `(( :background ,background
- :foreground ,foreground)
- forge-topic-label))))
- (pcase-lambda (`(,name))
- (magit--propertize-face name 'forge-topic-label)))))
- (if concat
- (mapconcat format labels (if (stringp concat) concat " "))
- (mapcar format labels))))
-
-(defun forge--format-marks (&optional arg concat)
- (and-let* ((marks (if (forge-topic--eieio-childp arg)
- (oref arg marks)
- ;; Unlike labels, marks are not repo-specific.
- (when (forge-repository-p arg) (setq arg nil))
- (forge-sql-cdr `[:select * :from mark
- ,@(and arg '(:where (in name $v1)))
- :order-by [(asc name)]]
- (vconcat arg))))
- (format (pcase-lambda (`(,_id ,name ,face ,_description))
- (magit--propertize-face
- name (list face 'forge-topic-label)))))
- (if concat
- (mapconcat format marks (if (stringp concat) concat " "))
- (mapcar format marks))))
-
-(defun forge--format-topic-state (topic)
- (with-slots (state) topic
- (magit--propertize-face
- (symbol-name state)
- (pcase (list (if (forge-issue-p topic) 'issue 'pullreq) state)
- ('(issue open) 'forge-issue-open)
- ('(issue closed) 'forge-issue-completed)
- ('(issue completed) 'forge-issue-completed)
- ('(issue unplanned) 'forge-issue-unplanned)
- ('(pullreq open) 'forge-pullreq-open)
- ('(pullreq merged) 'forge-pullreq-merged)
- ('(pullreq closed) 'forge-pullreq-rejected)))))
-
-(defun forge--format-topic-status (topic)
- (with-slots (status) topic
- (magit--propertize-face
- (symbol-name status)
- (pcase status
- ('unread 'forge-topic-unread)
- ('pending 'forge-topic-pending)
- ('done 'forge-topic-done)))))
-
-(defun forge--format-topic-assignees (topic)
- (and-let* ((assignees (oref topic assignees)))
- (mapconcat #'forge--format-person assignees ", ")))
-
-(defun forge--format-topic-review-requests (topic)
- (and-let* ((review-requests (oref topic review-requests)))
- (mapconcat #'forge--format-person review-requests ", ")))
-
-(defun forge--format-person (person)
- (pcase-let ((`(,_id ,login ,name) person))
- (format "%s%s (@%s)"
- (forge--format-avatar login)
- name login)))
-
-(defun forge--format-avatar (person)
- (if forge-format-avatar-function
- (funcall forge-format-avatar-function person)
- ""))
-
-(defun forge--format-boolean (slot name &optional obj)
- ;; Booleans are formatted differently in transients and headers.
- ;; Use this to format the (complete) description of suffix commands.
- (let ((obj (or obj (forge-current-topic))))
- (if (and obj (slot-exists-p obj slot))
- (format (propertize "[%s]" 'face 'transient-delimiter)
- (propertize name 'face
- (if (eieio-oref obj slot)
- 'transient-value
- 'transient-inactive-value)))
- (format "[%s]" name))))
-
-;;; Insert
-
-(defun forge-insert-topics (type heading prepare)
- "Insert a list of topics, according to PREPARE.
-
-This function is not intended to be added to section hooks directly.
-Instead create a function, which calls this function, and add wrapper
-to the section hook.
-
-PREPARE is a function which takes one arguments the repository object,
-and must return an filter object of type `forge--topics-spec' or nil.
-Insert no topics if PREPARE returns nil, or if the current repository
-isn't tracked or Forge hasn't been fully setup yet (in the latter two
-cases don't even call PREPARE).
-
-The filter object can be created either using `forge--topics-spec' or
-by `clone'ing the object returned by `forge--init-buffer-topics-spec',
-to share some settings with other topic lists in the same buffer.
-See `forge--topics-spec' for the valid slots and their values.
-
-HEADING is used as the heading of the list section and TYPE is used as
-its type. TYPE should be a symbol of the form `SUBSET-KIND', where KIND
-is one of `topics', `issues' or `pullreqs', and SUBSET should describe
-what subset of KIND is being listed."
- (declare (indent defun))
- (when-let (((forge-db t))
- (repo (forge-get-repository :tracked?))
- (spec (funcall prepare repo)))
- (forge--insert-topics type heading (forge--list-topics spec repo))))
-
-(defun forge--insert-topics (type heading topics)
- (when topics
- (let ((width (apply #'max (--map (length (oref it slug)) topics))))
- (magit-insert-section ((eval type) heading t)
- (magit-insert-heading
- (concat (magit--propertize-face (concat heading " ")
- 'magit-section-heading)
- (magit--propertize-face (format "(%s)" (length topics))
- 'magit-section-child-count)))
- (magit-insert-section-body
- (dolist (topic topics)
- (forge--insert-topic topic width))
- (insert ?\n)
- (magit-make-margin-overlay nil t))))))
-
-(defun forge--insert-topic (topic &optional width)
- (magit-insert-section ((eval (oref topic closql-table)) topic t)
- (insert (forge--format-topic-line topic (or width 5)))
- (forge--insert-topic-marks topic t)
- (forge--insert-topic-labels topic t)
- (insert "\n")
- (magit-log-format-author-margin
- (oref topic author)
- (format-time-string "%s" (parse-iso8601-time-string (oref topic created)))
- t)
- (when (and (slot-exists-p topic 'merged)
- (not (oref topic merged)))
- (magit-insert-heading)
- (magit-insert-section-body
- (forge--insert-pullreq-commits topic)))))
-
-(defun forge--insert-topic-labels (topic &optional separate)
- (and-let* ((labels (oref topic labels)))
- (prog1 t
- (pcase-dolist (`(,_id ,name ,color ,description) labels)
- (let* ((background (forge--sanitize-color color))
- (foreground (readable-foreground-color background)))
- (if separate (insert " ") (setq separate t))
- (insert name)
- (let ((o (make-overlay (- (point) (length name)) (point))))
- (overlay-put o 'priority 2)
- (overlay-put o 'evaporate t)
- (overlay-put o 'font-lock-face
- `(( :background ,background
- :foreground ,foreground)
- forge-topic-label))
- (when description
- (overlay-put o 'help-echo description))))))))
-
-(defun forge--insert-topic-marks (topic &optional separate)
- (and-let* ((marks (oref topic marks)))
- (prog1 t
- (pcase-dolist (`(,_id ,name ,face ,description) marks)
- (if separate (insert " ") (setq separate t))
- (insert name)
- (let ((o (make-overlay (- (point) (length name)) (point))))
- (overlay-put o 'priority 2)
- (overlay-put o 'evaporate t)
- (overlay-put o 'font-lock-face (list face 'forge-topic-label))
- (when description
- (overlay-put o 'help-echo description)))))))
-
-;;; Modes
-
-(defvar-keymap forge-common-map
- :doc "Parent keymap of many of Forge's keymaps.
-Keymaps that use this keymap as the/a parent keymap, remap the
-place-holder commands `forge--list-menu' and/or `forge--item-menu'
-to the appropriate menu command. To change the keys bound to menu
-commands in all Forge keymaps, one only has to change them here."
- "C-c C-c" #'forge--list-menu
- "C-c RET" #'forge--item-menu
- "C-<return>" #'forge--item-menu)
-
-(defun forge--list-menu ()
- "Place-holder menu command. See `forge-common-map'."
- (interactive)
- (message "No list menu available here"))
-(put 'forge--list-menu 'completion-predicate #'ignore)
-
-(defun forge--item-menu ()
- "Place-holder menu command. See `forge-common-map'."
- (interactive)
- (message "No item menu available here"))
-(put 'forge--item-menu 'completion-predicate #'ignore)
-
-(defvar-keymap forge-post-section-map
- "<remap> <magit-edit-thing>" #'forge-edit-post
- "C-c C-k" #'forge-delete-comment)
-
-(defvar-keymap forge-topic-mode-map
- :parent (make-composed-keymap forge-common-map magit-mode-map)
- "<remap> <magit-visit-thing>" #'markdown-follow-link-at-point
- "<mouse-2>" #'markdown-follow-link-at-point
- "<remap> <forge--item-menu>" #'forge-topic-menu
- "<remap> <forge--list-menu>" #'forge-topic-menu
- "C-c C-n" #'forge-create-post
- "C-c C-r" #'forge-create-post)
-
-(define-derived-mode forge-topic-mode magit-mode "Topic"
- "Parent major mode of `forge-{issue,pullreq}-mode'.
-This mode itself is never used directly."
- :interactive nil
- (face-remap-add-relative 'header-line 'forge-topic-header-line)
- (setq-local markdown-translate-filename-function
- #'forge--markdown-translate-filename-function))
-
-(defvar-keymap forge-issue-mode-map :parent forge-topic-mode-map)
-(define-derived-mode forge-issue-mode forge-topic-mode "Issue"
- "Major mode for looking at a Forge issue."
- :interactive nil)
-(defalias 'forge-issue-setup-buffer #'forge-topic-setup-buffer)
-(defalias 'forge-issue-refresh-buffer #'forge-topic-refresh-buffer)
-(defvar forge-issue-headers-hook
- '(forge-insert-topic-state
- forge-insert-topic-status
- forge-insert-topic-milestone
- forge-insert-topic-labels
- forge-insert-topic-marks
- forge-insert-topic-assignees))
-
-(defvar-keymap forge-pullreq-mode-map :parent forge-topic-mode-map)
-(define-derived-mode forge-pullreq-mode forge-topic-mode "Pull-request"
- "Major mode for looking at a Forge pull-request."
- :interactive nil)
-(defalias 'forge-pullreq-setup-buffer #'forge-topic-setup-buffer)
-(defalias 'forge-pullreq-refresh-buffer #'forge-topic-refresh-buffer)
-(defvar forge-pullreq-headers-hook
- '(forge-insert-topic-state
- forge-insert-topic-draft
- forge-insert-topic-status
- forge-insert-topic-saved
- forge-insert-topic-refs
- forge-insert-topic-milestone
- forge-insert-topic-labels
- forge-insert-topic-marks
- forge-insert-topic-assignees
- forge-insert-topic-review-requests))
-
-(defvar-local forge-buffer-topic nil)
-
-(defun forge-topic-setup-buffer (topic)
- (let* ((repo (forge-get-repository topic))
- (name (format "*forge: %s %s*" (oref repo slug) (oref topic slug)))
- (magit-generate-buffer-name-function (lambda (_mode _value) name)))
- (magit-setup-buffer-internal
- (if (forge-issue-p topic) #'forge-issue-mode #'forge-pullreq-mode)
- t `((forge-buffer-topic ,topic))
- name (or (forge-get-worktree repo) "/"))
- (forge-topic-mark-read topic)))
-
-(defun forge-topic-refresh-buffer ()
- (let ((topic (closql-reload forge-buffer-topic)))
- (setq forge-buffer-topic topic)
- (magit-set-header-line-format (forge--format-topic-line topic))
- (magit-insert-section (topicbuf)
- (magit-insert-headers
- (intern (format "%s-headers-hook"
- (substring (symbol-name major-mode) 0 -5))))
- (when (forge-pullreq-p topic)
- (magit-insert-section (pullreq topic)
- (magit-insert-heading "Commits")
- (forge--insert-pullreq-commits topic t)))
- (when-let ((note (oref topic note)))
- (magit-insert-section (note)
- (magit-insert-heading "Note")
- (insert (forge--fontify-markdown note) "\n\n")))
- (dolist (post (cons topic (oref topic posts)))
- (with-slots (author created body) post
- (magit-insert-section
- ( post post nil
- :heading-highlight-face 'magit-diff-hunk-heading-highlight)
- (let ((heading
- (format-spec
- forge-post-heading-format
- `((?a . ,(propertize (concat (forge--format-avatar author)
- (or author "(ghost)"))
- 'font-lock-face 'forge-post-author))
- (?c . ,(propertize created 'font-lock-face 'forge-post-date))
- (?C . ,(propertize (apply #'format "%s %s ago"
- (magit--age
- (float-time
- (date-to-time created))))
- 'font-lock-face 'forge-post-date))))))
- (font-lock-append-text-property
- 0 (length heading)
- 'font-lock-face 'magit-diff-hunk-heading heading)
- (magit-insert-heading heading))
- (insert (forge--fontify-markdown body) "\n\n"))))
- (when (and (display-images-p)
- (fboundp 'markdown-display-inline-images))
- (let ((markdown-display-remote-images t))
- (markdown-display-inline-images))))))
-
-(cl-defmethod magit-buffer-value (&context (major-mode forge-topic-mode))
- (oref forge-buffer-topic slug))
-
-;;; Headers
-
-(cl-defmacro forge--define-topic-header
- (name &key insert format (command nil command?))
- (declare (indent defun))
- (let ((fun (intern (format "forge-insert-topic-%s" name)))
- (map (intern (format "forge-topic-%s-section-map" name)))
- (cmd (intern (format "forge-topic-set-%s" name))))
- `(progn
- (cl-defun ,fun (&optional (topic forge-buffer-topic))
- (magit-insert-section (,(intern (format "topic-%s" name)))
- (insert ,(capitalize (string-pad (format "%s: " name) 11)))
- ,(cond
- (insert
- `(unless (funcall ,insert topic)
- (insert (magit--propertize-face "none" 'magit-dimmed))))
- (format
- `(insert (or (funcall ,format topic)
- (magit--propertize-face "none" 'magit-dimmed)))))
- (insert ?\n)))
- ,@(and (if command? command t)
- `((defvar-keymap ,map "<remap> <magit-edit-thing>"
- ,(or command `(function ,cmd)))
- (put ',fun 'definition-name ',name)))
- (put ',map 'definition-name ',name))))
-
-(forge--define-topic-header refs
- :command nil
- :format #'forge--format-topic-refs)
-
-(forge--define-topic-header draft
- :command #'forge-topic-toggle-draft
- :format #'forge--format-topic-draft)
-
-(forge--define-topic-header saved
- :command #'forge-topic-toggle-saved
- :format #'forge--format-topic-saved)
-
-(forge--define-topic-header state
- :command #'forge-topic-state-menu
- :format #'forge--format-topic-state)
-
-(forge--define-topic-header status
- :command #'forge-topic-status-menu
- :format #'forge--format-topic-status)
-
-(forge--define-topic-header milestone
- :format #'forge--format-topic-milestone)
-
-(forge--define-topic-header labels
- :insert #'forge--insert-topic-labels)
-
-(forge--define-topic-header marks
- :insert #'forge--insert-topic-marks)
-
-(forge--define-topic-header assignees
- :format #'forge--format-topic-assignees)
-
-(forge--define-topic-header review-requests
- :format #'forge--format-topic-review-requests)
-
-;;; Commands
-;;;; Groups
-
-(defconst forge--lists-group
- ["List"
- ("l r" "repositories" forge-list-repositories)
- ("l n" "notifications" forge-list-notifications)
- ("l g" "global topics" forge-list-global-topics)
- ("l t" "topics" forge-list-topics)
- ""])
-
-(defconst forge--topic-menus-group
- ["Menu"
- ("m s" "edit" forge-topic-menu)
- ("m f" "filter" forge-topics-menu)
- ("m f" "filter" forge-notifications-menu)
- ("m f" "filter" forge-repositories-menu)
- ("m d" "dispatch" forge-dispatch)
- ("m c" "configure" forge-configure)
- ""])
-
-(defconst forge--topic-set-state-group
- [:description
- (lambda () (if forge--show-topic-legend "Set public state" "Set state"))
- ("o" forge-topic-state-set-open)
- ("c" forge-issue-state-set-completed)
- ("x" forge-issue-state-set-unplanned)
- ("c" forge-pullreq-state-set-merged)
- ("x" forge-pullreq-state-set-rejected)])
-
-(defconst forge--topic-set-status-group
- [:description
- (lambda () (if forge--show-topic-legend "Set private status" "Set status"))
- ("u" forge-topic-status-set-unread)
- ("p" forge-topic-status-set-pending)
- ("d" forge-topic-status-set-done)])
-
-(defconst forge--topic-legend-group
- '(["Legend" :if-non-nil forge--show-topic-legend
- (:info* (lambda () (propertize "open issue" 'face 'forge-issue-open)))
- (:info* (lambda () (propertize "completed issue" 'face 'forge-issue-completed)))
- (:info* (lambda () (propertize "unplanned issue" 'face 'forge-issue-unplanned)))]
- ["" :if-non-nil forge--show-topic-legend
- (:info* (lambda () (propertize "open pullreq" 'face 'forge-pullreq-open)))
- (:info* (lambda () (propertize "merged pullreq" 'face 'forge-pullreq-merged)))
- (:info* (lambda () (propertize "rejected pullreq" 'face 'forge-pullreq-rejected)))]
- ["" :if-non-nil forge--show-topic-legend
- (:info* (lambda () (propertize "unread" 'face 'forge-topic-unread)))
- (:info* (lambda () (propertize "pending" 'face 'forge-topic-pending)))
- (:info* (lambda () (propertize "done" 'face 'forge-topic-done)))]
- ["" :if-non-nil forge--show-topic-legend
- (:info* (lambda () (propertize "draft" 'face 'forge-pullreq-draft)))]))
-
-(defvar forge--show-topic-legend t)
-
-(transient-define-suffix forge-toggle-topic-legend ()
- "Toggle whether to show legend for faces used in topic menus and lists."
- :description (lambda () (if forge--show-topic-legend "hide legend" "show legend"))
- :transient t
- (interactive)
- (customize-set-variable 'forge--show-topic-legend
- (not forge--show-topic-legend)))
-
-(defconst forge--topic-menus-column-widths '(21 21 21 21))
-
-;;;; Menus
-
-;;;###autoload(autoload 'forge-topic-menu "forge-topic" nil t)
-(transient-define-prefix forge-topic-menu ()
- "Edit the topic at point."
- :transient-suffix t
- :transient-non-suffix #'transient--do-call
- :transient-switch-frame nil
- :refresh-suffixes t
- :environment #'forge--menu-environment
- :column-widths forge--topic-menus-column-widths
- [:hide always ("q" forge-menu-quit-list)]
- [forge--topic-menus-group
- forge--topic-set-state-group
- forge--topic-set-status-group
- ["Actions"
- ("/f" forge-pull-this-topic)
- ("/b" forge-browse-this-topic)
- ("/c" forge-checkout-this-pullreq)]]
- [forge--lists-group
- ["Set "
- ("-m" forge-topic-set-milestone)
- ("-l" forge-topic-set-labels)
- ("-x" forge-topic-set-marks)
- ("-a" forge-topic-set-assignees)
- ("-r" forge-topic-set-review-requests)
- ("-n" forge-edit-topic-note)
- ("-t" forge-topic-set-title)]
- ["Set"
- ("-s" forge-topic-toggle-saved)
- ("-d" forge-topic-toggle-draft)
- """Display"
- ("-H" forge-toggle-topic-legend)]]
- [forge--topic-legend-group])
-
-(transient-augment-suffix forge-topic-menu
- :transient #'transient--do-replace
- :inapt-if (lambda () (or (derived-mode-p 'forge-repository-list-mode)
- (eq (oref transient--prefix command) 'forge-topic-menu)))
- :inapt-face (lambda () (if (derived-mode-p 'forge-repository-list-mode)
- 'transient-inapt-suffix
- 'forge-suffix-active)))
-
-;;;###autoload(autoload 'forge-topic-state-menu "forge-topic" nil t)
-(transient-define-prefix forge-topic-state-menu ()
- "Set state of the current topic."
- :environment #'forge--menu-environment
- [forge--topic-set-state-group])
-
-;;;###autoload(autoload 'forge-topic-status-menu "forge-topic" nil t)
-(transient-define-prefix forge-topic-status-menu ()
- "Set status of the current topic."
- :environment #'forge--menu-environment
- [forge--topic-set-status-group])
-
-(defun forge--menu-environment (fn)
- (let ((magit--refresh-cache (list (cons 0 0))))
- (funcall fn)))
-
-;;;; State
-
-(defclass forge--topic-set-state-command (transient-suffix)
- ((state :initarg :state)
- (getter :initarg :getter)
- (definition
- :initform (lambda ()
- (interactive)
- (with-slots (getter state) (transient-suffix-object)
- (let ((topic (funcall getter t)))
- (forge--set-topic-state (forge-get-repository topic)
- topic state)))))
- (description
- :initform (lambda (obj)
- (symbol-name (oref obj state))))
- (inapt-if
- :initform (lambda ()
- (or (forge-region-topics)
- (with-slots (getter state) (transient-suffix-object)
- (if-let ((topic (funcall getter)))
- ;; Once a pull-request is merged,
- ;; its state cannot be changed anymore.
- (memq (oref topic state) (list state 'merged))
- t)))))
- (inapt-face
- :initform (lambda (obj)
- (with-slots (getter state) (transient-suffix-object)
- (if (and (not (forge-region-topics))
- (and-let* ((topic (funcall getter)))
- (eq (oref topic state) state)))
- 'forge-suffix-active
- 'transient-inapt-suffix))))))
-
-(transient-define-suffix forge-topic-state-set-open ()
- "Set the state of the current topic to `open'."
- :class 'forge--topic-set-state-command
- :state 'open
- :getter #'forge-current-topic)
-
-(transient-define-suffix forge-issue-state-set-completed ()
- "Set the state of the current issue to `completed'."
- :class 'forge--topic-set-state-command
- :state 'completed
- :getter #'forge-current-issue)
-
-(transient-define-suffix forge-issue-state-set-unplanned ()
- "Set the state of the current issue to `unplanned'."
- :class 'forge--topic-set-state-command
- :state 'unplanned
- :getter #'forge-current-issue)
-
-(transient-define-suffix forge-pullreq-state-set-merged ()
- "If the current pull-request is merged, then visualize that."
- :class 'forge--topic-set-state-command
- :state 'merged
- :getter #'forge-current-pullreq
- (interactive)
- (message "Please use a merge command for this"))
-
-(transient-define-suffix forge-pullreq-state-set-rejected ()
- "Set the state of the current pull-request to `rejected'."
- :class 'forge--topic-set-state-command
- :state 'rejected
- :getter #'forge-current-pullreq)
-
-;;;; Status
-
-(defclass forge--topic-set-status-command (transient-suffix)
- ((status :initarg :status)
- (definition
- :initform (lambda ()
- (interactive)
- (with-slots (status) (transient-suffix-object)
- (if-let ((topics (forge-region-topics)))
- (dolist (topic topics)
- (oset topic status status))
- (oset (forge-current-topic t) status status)))
- (forge-refresh-buffer)))
- (description
- :initform (lambda (obj)
- (symbol-name (oref obj status))))
- (inapt-if
- :initform (lambda ()
- (and (not (forge-region-topics))
- (if-let ((topic (forge-current-topic)))
- (eq (oref topic status)
- (oref (transient-suffix-object) status))
- t))))
- (inapt-face
- :initform (lambda ()
- (if (forge-current-topic)
- 'forge-suffix-active
- 'transient-inapt-suffix)))))
-
-(transient-define-suffix forge-topic-status-set-unread ()
- "Set the notification status of the current topic to `unread'."
- :class 'forge--topic-set-status-command :status 'unread)
-
-(transient-define-suffix forge-topic-status-set-pending ()
- "Set the notification status of the current topic to `pending'."
- :class 'forge--topic-set-status-command :status 'pending)
-
-(transient-define-suffix forge-topic-status-set-done ()
- "Set the notification status of the current topic to `done'."
- :class 'forge--topic-set-status-command :status 'done)
-
-;;;; Set
-
-(defclass forge--topic-set-slot-command (transient-suffix)
- ((slot :initarg :slot)
- (setter)
- (reader)
- (formatter :initarg :formatter)
- (definition
- :initform (lambda (value)
- (interactive
- (list (funcall (oref (transient-suffix-object) reader)
- (forge-current-topic t))))
- (let ((topic (forge-current-topic t)))
- (funcall (oref (transient-suffix-object) setter)
- (forge-get-repository topic)
- topic value))))
- (description
- :initform (lambda (obj)
- (with-slots (slot inapt-if-not) obj
- (if-let* ((topic (if inapt-if-not
- (funcall inapt-if-not)
- (forge-current-topic)))
- (value (funcall (oref obj formatter) topic)))
- (format "%s %s" slot value)
- (format "%s" slot)))))))
-
-(cl-defmethod initialize-instance :after
- ((obj forge--topic-set-slot-command) &optional _slots)
- (with-slots (slot) obj
- (let ((name (symbol-name slot)))
- (cond ((string-suffix-p "-p" name)
- (setq name (substring name 0 -2))
- (oset obj reader (lambda (topic) (not (eieio-oref topic slot)))))
- ((oset obj reader (intern (format "forge-read-topic-%s" name)))))
- (oset obj setter (intern (format "forge--set-topic-%s" name)))
- (unless (slot-boundp obj 'formatter)
- (oset obj formatter (intern (format "forge--format-topic-%s" name)))))))
-
-(transient-define-suffix forge-topic-set-title (title)
- "Edit the TITLE of the current topic."
- :class 'forge--topic-set-slot-command :slot 'title
- :formatter (lambda (topic)
- (propertize (truncate-string-to-width
- (forge--format-topic-title topic) 34 nil ?\s t)
- 'face 'font-lock-string-face)))
-
-(transient-define-suffix forge-topic-set-milestone (milestone)
- "Edit what MILESTONE the current topic belongs to."
- :class 'forge--topic-set-slot-command :slot 'milestone)
-
-(transient-define-suffix forge-topic-set-labels (labels)
- "Edit the LABELS of the current topic."
- :class 'forge--topic-set-slot-command :slot 'labels
- :formatter (lambda (topic) (forge--format-labels topic t)))
-
-(transient-define-suffix forge-topic-set-marks (marks)
- "Edit the MARKS of the current topic."
- :class 'forge--topic-set-slot-command :slot 'marks
- :formatter (lambda (topic) (forge--format-marks topic t)))
-
-(transient-define-suffix forge-topic-set-assignees (assignees)
- "Edit the ASSIGNEES of the current topic."
- :class 'forge--topic-set-slot-command :slot 'assignees)
-
-(transient-define-suffix forge-topic-set-review-requests (review-requests)
- "Edit the REVIEW-REQUESTS of the current pull-request."
- :class 'forge--topic-set-slot-command :slot 'review-requests
- :inapt-if-not #'forge-current-pullreq)
-
-(transient-define-suffix forge-topic-toggle-draft (draft)
- "Toggle whether the current pull-request is a draft."
- :class 'forge--topic-set-slot-command :slot 'draft-p
- :inapt-if-not #'forge-current-pullreq
- :description (lambda () (forge--format-boolean 'draft-p "draft")))
-
-(transient-define-suffix forge-topic-toggle-saved ()
- "Toggle whether this topic is marked as saved."
- :class 'forge--topic-set-slot-command :slot 'saved-p
- :description (lambda () (forge--format-boolean 'saved-p "saved"))
- ;; Set only locally because Github's API does not support this.
- (interactive)
- (let ((topic (forge-current-topic t)))
- (oset topic saved-p (not (oref topic saved-p))))
- (forge-refresh-buffer))
-
-;;; Color Utilities
-
-(defun forge--sanitize-color (color)
- (cond ((color-values color) color)
- ;; Discard alpha information.
- ((string-match-p "\\`#.\\{4\\}\\'" color) (substring color 0 3))
- ((string-match-p "\\`#.\\{8\\}\\'" color) (substring color 0 6))
- (t "#000000"))) ; Use fallback instead of invalid color.
-
-;;; Markdown Utilities
-
-(defun forge--fontify-markdown (text)
- (with-temp-buffer
- (delay-mode-hooks
- (gfm-mode))
- (insert text)
- (font-lock-ensure)
- (when forge-post-fill-region
- (fill-region (point-min) (point-max)))
- (buffer-string)))
-
-(defun forge--markdown-translate-filename-function (file)
- (if (string-match-p "\\`https?://" file)
- file
- (let ((host (oref (forge-get-repository :tracked) forge))) ;aka webhost
- (concat (if (member host ghub-insecure-hosts) "http://" "https://")
- host
- (and (not (string-prefix-p "/" file)) "/")
- file))))
-
-;;; Templates
-
-(defun forge--topic-parse-buffer (&optional file)
- (save-match-data
- (save-excursion
- (goto-char (point-min))
- (let ((alist (save-excursion (forge--topic-parse-yaml))))
- (if alist
- (setf (alist-get 'yaml alist) t)
- (setq alist (save-excursion (forge--topic-parse-plain))))
- (setf (alist-get 'file alist) file)
- (setf (alist-get 'text alist) (magit--buffer-string nil nil ?\n))
- (when (and file (not (alist-get 'prompt alist)))
- (setf (alist-get 'prompt alist)
- (file-name-sans-extension (file-name-nondirectory file))))
- ;; If there is a yaml front-matter, then it is supposed
- ;; to have a `title' field, but this may not be the case.
- (when (and (not file)
- (not (alist-get 'title alist)))
- (setf (alist-get 'title alist)
- (read-string "Title: ")))
- alist))))
-
-(defun forge--topic-parse-yaml ()
- (let (alist beg end)
- (when (looking-at "^---[\s\t]*$")
- (forward-line)
- (setq beg (point))
- (when (re-search-forward "^---[\s\t]*$" nil t)
- (setq end (match-beginning 0))
- (setq alist (yaml-parse-string
- (buffer-substring-no-properties beg end)
- :object-type 'alist
- :sequence-type 'list
- ;; FIXME Does not work because of
- ;; https://github.com/zkry/yaml.el/pull/28.
- :false-object nil))
- (let-alist alist
- (when (and .name .about)
- (setf (alist-get 'prompt alist)
- (format "[%s] %s" .name .about)))
- (when (and .labels (atom .labels))
- (setf (alist-get 'labels alist) (list .labels)))
- (when (and .assignees (atom .assignees))
- (setf (alist-get 'assignees alist) (list .assignees))))
- (forward-line)
- (when (and (not (alist-get 'title alist))
- (looking-at "^\n?#*"))
- (goto-char (match-end 0))
- (setf (alist-get 'title alist)
- (string-trim
- (magit--buffer-string (point) (line-end-position) t)))
- (forward-line))
- (setf (alist-get 'body alist)
- (string-trim (magit--buffer-string (point) nil ?\n)))))
- alist))
-
-(defun forge--topic-parse-plain ()
- (let (title body)
- (when (looking-at "\\`#*")
- (goto-char (match-end 0)))
- (setq title (magit--buffer-string (point) (line-end-position) t))
- (forward-line)
- (setq body (magit--buffer-string (point) nil ?\n))
- `((title . ,(string-trim title))
- (body . ,(string-trim body)))))
-
-(defun forge--topic-parse-link-buffer ()
- (save-match-data
- (save-excursion
- (goto-char (point-min))
- (mapcar (lambda (alist)
- (cons (cons 'prompt (concat (alist-get 'name alist) " -- "
- (alist-get 'about alist)))
- alist))
- (forge--topic-parse-yaml-links)))))
-
-(defun forge--topic-parse-yaml-links ()
- (alist-get 'contact_links
- (yaml-parse-string (buffer-substring-no-properties
- (point-min)
- (point-max))
- :object-type 'alist
- :sequence-type 'list)))
-
-(cl-defgeneric forge--topic-template-files (repo class)
- "Return a list of topic template files for REPO and a topic of CLASS.")
-
-(cl-defgeneric forge--topic-template (repo class)
- "Return a topic template alist for REPO and a topic of CLASS.
-If there are multiple templates, then the user is asked to select
-one of them. It there are no templates, then return a very basic
-alist, containing just `text' and `position'.")
-
-(defun forge--topic-templates-data (repo class)
- (let ((branch (oref repo default-branch)))
- (mapcan (lambda (f)
- (with-temp-buffer
- (magit-git-insert "cat-file" "-p" (concat branch ":" f))
- (if (equal (file-name-nondirectory f) "config.yml")
- (forge--topic-parse-link-buffer)
- (list (forge--topic-parse-buffer f)))))
- (forge--topic-template-files repo class))))
-
-(cl-defmethod forge--topic-template ((repo forge-repository)
- (class (subclass forge-topic)))
- (let ((choices (forge--topic-templates-data repo class)))
- (if (cdr choices)
- (let ((c (magit-completing-read
- (if (eq class 'forge-pullreq)
- "Select pull-request template"
- "Select issue template")
- (--map (alist-get 'prompt it) choices)
- nil t)))
- (--first (equal (alist-get 'prompt it) c) choices))
- (car choices))))
-
-;;; Bug-Reference
-
-(defun forge-bug-reference-setup ()
- "Setup `bug-reference' in the current buffer.
-If forge data has been fetched for the current repository, then
-enable `bug-reference-mode' or `bug-reference-prog-mode' and
-modify `bug-reference-bug-regexp' if appropriate."
- (unless (or bug-reference-url-format
- (not (forge-db t))
- ;; TODO Allow use in these modes again.
- (derived-mode-p 'forge-topics-mode 'forge-notifications-mode))
- (magit--with-safe-default-directory nil
- (when-let ((repo (forge-get-repository :tracked?)))
- (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)))))))))
- (if (derived-mode-p 'prog-mode)
- (bug-reference-prog-mode 1)
- (bug-reference-mode 1))
- (add-hook 'completion-at-point-functions
- #'forge-topic-completion-at-point nil t)))))
-
-(unless noninteractive
- (dolist (hook forge-bug-reference-hooks)
- (add-hook hook #'forge-bug-reference-setup)))
-
-;;; _
-(provide 'forge-topic)
-;;; forge-topic.el ends here
+++ /dev/null
-;;; forge-topics.el --- List topics -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2024 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This file is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this file. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'forge-topic)
-
-;;; Options
-
-(defcustom forge-list-buffer-default-topic-filters
- (forge--topics-spec :type 'topic :active t :state 'open :order 'newest)
- "Filters initially used to limit topics listed in list buffers.
-
-This option controls which topics are listed when initially creating
-a `forge-topics-mode' buffer. To temporarily change which topics are
-listed in a given buffer, instead use \\`N m' (`forge-topics-menu')."
- :package-version '(forge . "0.4.0")
- :group 'forge
- :type 'object)
-
-(defcustom forge-status-buffer-default-topic-filters
- (forge--topics-spec :type 'topic :active t :state 'open :order 'newest)
- "Filters initially used to limit topics listed in status buffers.
-
-This option controls which topics are listed when initially creating
-a `magit-status-mode' buffer. To temporarily change which topics are
-listed in a given buffer, instead use \\<forge-topics-mode-map> \
-\\[forge-topics-menu] (`forge-topics-menu').
-
-To initially list no topics, set the `type' slot to nil."
- :package-version '(forge . "0.4.0")
- :group 'forge
- :type 'object)
-
-(defcustom forge-owned-accounts nil
- "An alist of accounts that are owned by you.
-This should include your username as well as any organization
-that you own. Used by the commands `forge-list-owned-issues',
-`forge-list-owned-pullreqs' and `forge-fork'.
-
-Each element has the form (ACCOUNT . PLIST). The following
-properties are currently being used:
-
-`remote-name' The default name suggested by `forge-fork' for a
- fork created within this account. If unspecified, then the
- name of the account is used."
- :package-version '(forge . "0.2.0")
- :group 'forge
- :type '(repeat (cons (string :tag "Account") plist)))
-
-(defcustom forge-owned-ignored nil
- "A list of repositories that are ignored when listing those owned by you.
-This is a list of package names. Used by the commands
-`forge-list-owned-issues' and `forge-list-owned-pullreqs'."
- :package-version '(forge . "0.2.0")
- :group 'forge
- :type '(repeat (string :tag "Name")))
-
-;;; Faces
-
-(defface forge-suffix-active
- '((t :inherit transient-value :weight bold))
- "Face used for suffixes whose effects is currently active."
- :group 'forge-faces)
-
-(defface forge-suffix-active-and-implied
- '((t :inherit transient-value :weight semibold))
- "Face used for suffixes whose effects is currently active and implied."
- :group 'forge-faces)
-
-(defface forge-suffix-implied
- '((t :inherit transient-value :weight normal))
- "Face used for suffixes whose effects is currently implied."
- :group 'forge-faces)
-
-;;; Mode
-
-(defvar-keymap forge-topics-mode-map
- :doc "Local keymap for Forge-Topic-List mode buffers."
- :parent (make-composed-keymap forge-common-map magit-mode-map)
- "RET" #'forge-visit-this-topic
- "<return>" #'forge-visit-this-topic
- "o" #'forge-browse-this-topic
- "<remap> <forge--list-menu>" #'forge-topics-menu
- "<remap> <forge--item-menu>" #'forge-topic-menu
- "<remap> <magit-refresh>" #'forge-refresh-buffer)
-
-(defvar forge-topics-mode-name '((:eval (forge-topics-buffer-desc)))
- "Information shown in the mode-line for `forge-topics-mode'.
-Must be set before `forge-topics' is loaded.")
-
-(define-derived-mode forge-topics-mode magit-mode forge-topics-mode-name
- "Major mode for browsing a list of topics."
- :interactive nil
- (magit-hack-dir-local-variables))
-
-(defun forge-topics-setup-buffer (&optional repo spec &rest params)
- (let* ((global (or (plist-get params :global)
- (and spec (oref spec global))))
- (repo (or repo
- (and (not global)
- (if-let* ((topic (forge-topic-at-point))
- (repo (forge-get-repository topic)))
- repo
- (forge-get-repository :tracked?)))))
- (dir (or (and repo (forge-get-worktree repo)) "/"))
- (buf (forge-topics-buffer-name repo))
- (buf (or (get-buffer buf) buf))
- (spec (cond (spec (clone spec))
- ((and (bufferp buf)
- (buffer-local-value 'forge--buffer-topics-spec buf)))
- ((clone forge-list-buffer-default-topic-filters)))))
- (while-let ((key (pop params)))
- (eieio-oset spec key (pop params)))
- (unless (oref spec type)
- (oset spec type 'topic))
- (unless (or repo global)
- (error "Cannot determine repository"))
- (magit-setup-buffer-internal #'forge-topics-mode nil
- `((forge-buffer-repository
- ,(and repo (oref repo id)))
- (forge--buffer-topics-spec ,spec)
- (forge-buffer-unassociated-p ,global))
- (get-buffer-create buf)
- dir)))
-
-(defun forge-topics-refresh-buffer ()
- (magit-set-header-line-format (forge-topics-buffer-desc))
- (let ((topics (forge--list-topics
- forge--buffer-topics-spec
- (forge-get-repository :tracked?))))
- (magit-insert-section (topicbuf)
- (cond
- ((not topics)
- (insert "No matching topics\n"))
- ((not (oref forge--buffer-topics-spec grouped))
- (dolist (topic topics)
- (forge--insert-topic topic 5)))
- ((pcase-dolist (`(,_ . ,topics)
- (--group-by (oref it repository) topics))
- (let ((repo (forge-get-repository (car topics))))
- (magit-insert-section (forge-repo repo)
- (magit-insert-heading
- (concat (propertize (format "%s/%s"
- (oref repo owner)
- (oref repo name))
- 'font-lock-face 'bold)
- (format " (%s)" (length topics))))
- (dolist (topic topics)
- (forge--insert-topic topic 5))))))))))
-
-(defun forge-topics-buffer-desc ()
- (capitalize (concat (symbol-name (oref forge--buffer-topics-spec type)) "s")))
-
-(defun forge-topics-buffer-name (&optional repo)
- (if repo
- (format "*forge-topics: %s*" (oref repo slug))
- "*forge-topics*"))
-
-;;; Commands
-;;;; Menu
-
-;;;###autoload(autoload 'forge-topics-menu "forge-topics" nil t)
-(transient-define-prefix forge-topics-menu ()
- "Control list of topics displayed in the current buffer."
- :transient-suffix t
- :transient-non-suffix #'transient--do-call
- :transient-switch-frame nil
- :refresh-suffixes t
- :environment #'forge--menu-environment
- :column-widths forge--topic-menus-column-widths
- [:hide always ("q" forge-menu-quit-list)]
- [forge--topic-menus-group
- ["State"
- ("a" forge-topics-filter-active)
- ("o" forge-topics-filter-state-open)
- ("c" forge-topics-filter-state-completed)
- ("x" forge-topics-filter-state-unplanned)]
- ["Status"
- ("i" forge-topics-filter-status-inbox)
- ("u" forge-topics-filter-status-unread)
- ("p" forge-topics-filter-status-pending)
- ("d" forge-topics-filter-status-done)]
- ["Type"
- ("t t" forge-topics-all-types)
- ("t i" forge-topics-filter-issues)
- ("t p" forge-topics-filter-pullreqs)]]
- [forge--lists-group
- ["Filter "
- ("-m" forge-topics-filter-milestone)
- ("-l" forge-topics-filter-labels)
- ("-x" forge-topics-filter-marks)
- ("-c" forge-topics-filter-author)
- ("-a" forge-topics-filter-assignee)
- ("-r" forge-topics-filter-reviewer)
- ("-s" forge-topics-filter-saved)]
- ["Display"
- ("-O" forge-topics-set-order)
- ("-L" forge-topics-set-limit)
- ("-F" forge-topics-ungroup)
- ("-G" forge-topics-group)
- ("-S" forge-toggle-display-in-status-buffer)
- ("-H" forge-toggle-topic-legend)]]
- [forge--topic-legend-group]
- (interactive)
- (cond ((derived-mode-p 'forge-topics-mode 'magit-status-mode)
- (transient-setup 'forge-topics-menu))
- ((derived-mode-p 'forge-notifications-mode)
- (setq this-command 'forge-notifications-menu)
- (transient-setup 'forge-notifications-menu))
- ((forge-list-topics))))
-
-(transient-augment-suffix forge-topics-menu
- :transient #'transient--do-replace
- :if-not-derived '(forge-notifications-mode forge-repository-list-mode)
- :inapt-if (lambda () (eq (oref transient--prefix command) 'forge-topics-menu))
- :inapt-face 'forge-suffix-active)
-
-(defvar-local forge--quit-keep-topic-menu nil)
-
-(defun forge-menu-quit-list ()
- "From a transient menu, quit the list buffer and the menu.
-
-If quitting the list buffer causes another topic, repository list or
-notification list buffer to become current in the selected window,
-then display the respective menu, otherwise display no menu."
- (interactive)
- (let ((keep-topic-menu forge--quit-keep-topic-menu))
- (when (derived-mode-p 'forge-topic-mode
- 'forge-topics-mode
- 'forge-repository-list-mode
- 'forge-notifications-mode)
- (kill-local-variable 'forge--quit-keep-topic-menu)
- (quit-window))
- (cond ((derived-mode-p 'forge-topic-mode)
- (setq transient--exitp 'replace)
- (transient-setup (setq this-command 'forge-topic-menu)))
- ((derived-mode-p 'forge-topics-mode)
- (unless keep-topic-menu
- (setq transient--exitp 'replace)
- (transient-setup (setq this-command 'forge-topics-menu))))
- ((derived-mode-p 'forge-repository-list-mode)
- (setq transient--exitp 'replace)
- (transient-setup (setq this-command 'forge-repositories-menu)))
- ((derived-mode-p 'forge-notifications-mode)
- (setq transient--exitp 'replace)
- (transient-setup (setq this-command 'forge-notifications-menu)))
- (t
- (setq transient--exitp t)
- (transient--pre-exit)
- (transient--stack-zap)))))
-
-;;;; List
-
-;;;###autoload(autoload 'forge-list-topics "forge-topics" nil t)
-(transient-define-suffix forge-list-topics (&optional repo)
- "List topics of the current repository."
- :description "topics"
- :inapt-if (lambda () (or (not (forge--get-repository:tracked?))
- (and (eq major-mode 'forge-topics-mode)
- (not (oref forge--buffer-topics-spec global)))))
- :inapt-face (lambda () (if (not (forge--get-repository:tracked?))
- 'transient-inapt-suffix
- 'forge-suffix-active))
- (declare (interactive-only nil))
- (interactive)
- (forge-topics-setup-buffer repo)
- (transient-setup 'forge-topics-menu))
-
-;;;###autoload(autoload 'forge-list-issues "forge-topics" nil t)
-(transient-define-suffix forge-list-issues (&optional repo)
- "List issues of the current repository."
- :description "issues"
- (declare (interactive-only nil))
- (interactive)
- (forge-topics-setup-buffer repo nil :type 'issue)
- (transient-setup 'forge-topics-menu))
-
-;;;###autoload(autoload 'forge-list-pullreqs "forge-topics" nil t)
-(transient-define-suffix forge-list-pullreqs (&optional repo)
- "List pull-requests of the current repository."
- :description "pull-requests"
- (declare (interactive-only nil))
- (interactive)
- (forge-topics-setup-buffer repo nil :type 'pullreq)
- (transient-setup 'forge-topics-menu))
-
-;;;###autoload(autoload 'forge-list-global-topics "forge-topics" nil t)
-(transient-define-suffix forge-list-global-topics (&optional repo)
- "List topics across all tracked repository."
- :description "topics"
- :inapt-if (lambda () (and (eq major-mode 'forge-topics-mode)
- (oref forge--buffer-topics-spec global)))
- :inapt-face 'forge-suffix-active
- (declare (interactive-only nil))
- (interactive)
- (forge-topics-setup-buffer repo nil :global t)
- (transient-setup 'forge-topics-menu))
-
-;;;###autoload(autoload 'forge-list-global-issues "forge-topics" nil t)
-(transient-define-suffix forge-list-global-issues (&optional repo)
- "List issues across all tracked repository."
- :description "issues"
- (declare (interactive-only nil))
- (interactive)
- (forge-topics-setup-buffer repo nil :global t :type 'issue)
- (transient-setup 'forge-topics-menu))
-
-;;;###autoload(autoload 'forge-list-global-pullreqs "forge-topics" nil t)
-(transient-define-suffix forge-list-global-pullreqs (&optional repo)
- "List pull-requests across all tracked repository."
- :description "pull-requests"
- (declare (interactive-only nil))
- (interactive)
- (forge-topics-setup-buffer repo nil :global t :type 'pullreq)
- (transient-setup 'forge-topics-menu))
-
-;;;; Type
-
-(defclass forge--topics-filter-type-command (transient-suffix)
- ((type :initarg :type)
- (definition
- :initform (lambda (&optional repo)
- (interactive)
- (oset forge--buffer-topics-spec type
- (oref (transient-suffix-object) type))
- (forge-refresh-buffer)))
- (inapt-face :initform 'forge-suffix-active)
- (inapt-if
- :initform (lambda ()
- (eq (oref forge--buffer-topics-spec type)
- (oref (transient-suffix-object) type))))))
-
-(transient-define-suffix forge-topics-all-types ()
- :class 'forge--topics-filter-type-command :type 'topic
- :description "topics")
-
-(transient-define-suffix forge-topics-filter-issues ()
- "List issues of the current repository."
- :class 'forge--topics-filter-type-command :type 'issue
- :description "issues")
-
-(transient-define-suffix forge-topics-filter-pullreqs ()
- "List pull-requests of the current repository."
- :class 'forge--topics-filter-type-command :type 'pullreq
- :description "pull-requests")
-
-;;;; Active
-
-(transient-define-suffix forge-topics-filter-active ()
- "Limit topic list to active topics."
- :description "active"
- :face (lambda ()
- (and (oref forge--buffer-topics-spec active)
- 'forge-suffix-active))
- (interactive)
- (oset forge--buffer-topics-spec active
- (not (oref forge--buffer-topics-spec active)))
- (forge-refresh-buffer))
-
-;;;; State
-
-(defclass forge--topics-filter-state-command (transient-suffix)
- ((state :initarg :state)
- (definition
- :initform (lambda ()
- (interactive)
- (let ((want (oref (transient-suffix-object) state))
- (spec forge--buffer-topics-spec))
- (cond ((and (eq want 'open)
- (oref spec active))
- (oset spec active nil)
- (oset spec state want))
- ((equal (oref spec state) want)
- (oset spec state nil))
- (t
- (oset spec active nil)
- (oset spec state want))))
- (forge-refresh-buffer)))
- (description
- :initform (lambda (suffix)
- (let ((want (oref suffix state))
- (type (oref forge--buffer-topics-spec type)))
- (pcase type
- ((guard (atom want))
- (symbol-name want))
- ('topic (apply #'format "%s/%s" want))
- ('issue (symbol-name (car want)))
- ('pullreq (symbol-name (cadr want)))))))
- (face
- :initform (lambda (suffix)
- (let ((want (oref suffix state))
- (have (oref forge--buffer-topics-spec state))
- (active (oref forge--buffer-topics-spec active)))
- (cond ((and (not active)
- (equal have want))
- 'forge-suffix-active)
- ((and (or active
- (eq have 'open))
- (eq want 'open))
- (if (eq have want)
- 'forge-suffix-active-and-implied
- 'forge-suffix-implied))))))))
-
-(transient-define-suffix forge-topics-filter-state-open ()
- "Limit topic list to open topics."
- :class 'forge--topics-filter-state-command :state 'open)
-
-(transient-define-suffix forge-topics-filter-state-completed ()
- "Limit topic list to completed and merged topics."
- :class 'forge--topics-filter-state-command :state '(completed merged))
-
-(transient-define-suffix forge-topics-filter-state-unplanned ()
- "Limit topic list to unplanned and rejected topics."
- :class 'forge--topics-filter-state-command :state '(unplanned rejected))
-
-;;;; Status
-
-(defclass forge--topics-filter-status-command (transient-suffix)
- ((status :initarg :status)
- (definition
- :initform (lambda ()
- (interactive)
- (let* ((want (oref (transient-suffix-object) status))
- (spec forge--buffer-topics-spec)
- (have (oref spec status))
- (active (oref spec active)))
- (cond (active
- (oset spec active nil)
- (oset spec status want))
- ((eq have want)
- (oset spec status nil))
- ((oset spec status want))))
- (forge-refresh-buffer)))
- (description
- :initform (lambda (suffix) (symbol-name (oref suffix status))))
- (face
- :initform (lambda (suffix)
- (let ((want (oref suffix status))
- (have (oref forge--buffer-topics-spec status))
- (active (oref forge--buffer-topics-spec active)))
- (cond ((and (not active)
- (equal have want))
- 'forge-suffix-active)
- ((and (or active
- (eq have 'inbox))
- (memq want '(inbox unread pending)))
- (if (eq have want)
- 'forge-suffix-active-and-implied
- 'forge-suffix-implied))))))))
-
-(transient-define-suffix forge-topics-filter-status-inbox ()
- "Limit topic list to unread and pending topics."
- :class 'forge--topics-filter-status-command :status 'inbox)
-
-(transient-define-suffix forge-topics-filter-status-unread ()
- "Limit topic list to unread topics."
- :class 'forge--topics-filter-status-command :status 'unread)
-
-(transient-define-suffix forge-topics-filter-status-pending ()
- "Limit topic list to pending topics."
- :class 'forge--topics-filter-status-command :status 'pending)
-
-(transient-define-suffix forge-topics-filter-status-done ()
- "Limit topic list to done topics."
- :class 'forge--topics-filter-status-command :status 'done)
-
-;;;; Filter
-
-(defclass forge--topics-filter-command (transient-suffix)
- ((slot :initarg :slot)
- (reader :initarg :reader)
- (formatter :initarg :formatter :initform nil)
- (definition
- :initform (lambda ()
- (interactive)
- (with-slots (slot reader) (transient-suffix-object)
- (eieio-oset forge--buffer-topics-spec slot
- (if (eieio-oref forge--buffer-topics-spec slot)
- nil
- (funcall reader)))
- (forge-refresh-buffer))))
- (description
- :initform (lambda (obj)
- (with-slots (slot formatter) obj
- (let ((value (eieio-oref forge--buffer-topics-spec slot)))
- (if value
- (format "%s %s" slot
- (if formatter
- (funcall formatter value)
- (propertize (format "%s" value)
- 'face 'forge-suffix-active)))
- (format "%s" slot))))))))
-
-(cl-defmethod initialize-instance :after
- ((obj forge--topics-filter-command) &optional _slots)
- (unless (slot-boundp obj 'reader)
- (oset obj reader (intern (format "forge-read-topic-%s" (oref obj slot))))))
-
-(transient-define-suffix forge-topics-filter-milestone ()
- "Read a milestone and limit topic list to topics with that milestone."
- :class 'forge--topics-filter-command
- :slot 'milestone
- :formatter (lambda (m) (propertize m 'face 'forge-topic-label)))
-
-(transient-define-suffix forge-topics-filter-labels ()
- "Read labels and limit topic list to topics with one of these labels."
- :class 'forge--topics-filter-command
- :slot 'labels
- :formatter (lambda (labels) (and labels (forge--format-labels labels " "))))
-
-(transient-define-suffix forge-topics-filter-marks ()
- "Read marks and limit topic list to topics with one of these marks."
- :class 'forge--topics-filter-command
- :slot 'marks
- :formatter (lambda (marks) (and marks (forge--format-marks marks " "))))
-
-(transient-define-suffix forge-topics-filter-saved ()
- "Toggle whether to limit topic list to saved topics."
- :class 'forge--topics-filter-command
- :slot 'saved
- :reader #'always
- :description
- (lambda () (forge--format-boolean 'saved "saved" forge--buffer-topics-spec)))
-
-(transient-define-suffix forge-topics-filter-author ()
- "Read an author and limit topic list to topics created by that author."
- :class 'forge--topics-filter-command
- :slot 'author
- :reader (lambda () (forge--read-filter-by-user "Author")))
-
-(transient-define-suffix forge-topics-filter-assignee ()
- "Read an assignee and limit topic list to topics assignee to that person."
- :class 'forge--topics-filter-command
- :slot 'assignee
- :reader (lambda () (forge--read-filter-by-user "Assignee")))
-
-(transient-define-suffix forge-topics-filter-reviewer ()
- "Read a reviewer and limit topic list to reviews requested from that person."
- :class 'forge--topics-filter-command
- :slot 'reviewer
- :reader (lambda () (forge--read-filter-by-user "Reviewer")))
-
-(defun forge--read-filter-by-user (prompt)
- (let* ((repo (forge-get-repository :tracked))
- (choices (mapcar #'cadr (oref repo assignees))))
- (magit-completing-read prompt choices)))
-
-;;;; Display
-
-(transient-define-suffix forge-topics-set-order (order)
- "Select order used to display topics in topic list."
- :description
- (lambda ()
- (format "order by %s"
- (propertize (format "%s" (oref forge--buffer-topics-spec order))
- 'face 'bold)))
- (interactive
- (list (magit-read-char-case "Order by: " t
- (?n "[n]ewest" 'newest)
- (?o "[o]ldest" 'oldest)
- (?u "[r]ecently updated" 'recently-updated)
- (?U "[a]nciently updated" 'anciently-updated))))
- (oset forge--buffer-topics-spec order order)
- (forge-refresh-buffer))
-
-(transient-define-suffix forge-topics-set-limit (limit)
- "Read maximal number of topics to be displayed in topic list."
- :description
- (lambda ()
- (if-let ((limit (oref forge--buffer-topics-spec limit)))
- (format "limit to %s" (propertize (format "%s" limit) 'face 'bold))
- "no limit"))
- (interactive (list (read-number "Limit number (0 for no limit): ")))
- (oset forge--buffer-topics-spec limit (if (zerop limit) nil limit))
- (forge-refresh-buffer))
-
-(transient-define-suffix forge-topics-group ()
- "Group topics by repository."
- :description "group by repo"
- :if (lambda () (oref forge--buffer-topics-spec global))
- :inapt-if (lambda () (oref forge--buffer-topics-spec grouped))
- :inapt-face 'forge-suffix-active
- (interactive)
- (oset forge--buffer-topics-spec grouped t)
- (forge-refresh-buffer))
-
-(transient-define-suffix forge-topics-ungroup ()
- "Show a flat topic list."
- :description "single list"
- :if (lambda () (oref forge--buffer-topics-spec global))
- :inapt-if-not (lambda () (oref forge--buffer-topics-spec grouped))
- :inapt-face 'forge-suffix-active
- (interactive)
- (oset forge--buffer-topics-spec grouped nil)
- (forge-refresh-buffer))
-
-;;; _
-(provide 'forge-topics)
-;;; forge-topics.el ends here
+++ /dev/null
-;;; forge.el --- Access Git forges from Magit -*- lexical-binding:t -*-
-
-;; Copyright (C) 2018-2024 Jonas Bernoulli
-
-;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
-;; Homepage: https://github.com/magit/forge
-;; Keywords: git tools vc
-
-;; Package-Version: 20241218.2036
-;; Package-Revision: 3b80ace32c23
-;; Package-Requires: (
-;; (emacs "29.1")
-;; (compat "30.0.0.0")
-;; (closql "2.1.0")
-;; (dash "2.19.1")
-;; (emacsql "4.1.0")
-;; (ghub "4.2.0")
-;; (let-alist "1.0.6")
-;; (magit "4.1.3")
-;; (markdown-mode "2.6")
-;; (seq "2.24")
-;; (transient "0.8.0")
-;; (yaml "0.5.5"))
-
-;; SPDX-License-Identifier: GPL-3.0-or-later
-
-;; This file is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published
-;; by the Free Software Foundation, either version 3 of the License,
-;; or (at your option) any later version.
-;;
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this file. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Work with Git forges, such as Github and Gitlab, from the comfort
-;; of Magit and the rest of Emacs.
-
-;; The schema of the database has not been finalized yet. Until that
-;; has happened it will occasionally have to be discarded. For now
-;; the database does not contain any information that cannot simply
-;; be fetched again.
-
-;;; Code:
-
-(require 'magit)
-
-(require 'forge-db)
-(require 'forge-core)
-
-(provide 'forge)
-
-(require 'forge-repo)
-(require 'forge-post)
-(require 'forge-topic)
-(require 'forge-issue)
-(require 'forge-pullreq)
-(require 'forge-revnote)
-(require 'forge-notify)
-
-(require 'forge-github)
-(require 'forge-gitlab)
-(require 'forge-gitea)
-(require 'forge-gogs)
-(require 'forge-bitbucket)
-(require 'forge-semi)
-
-(require 'forge-commands)
-(require 'forge-topics)
-(require 'forge-repos)
-
-;;; Add Sections
-
-(defvar forge-add-default-sections t
- "Whether to add Forge's sections to `magit-status-sections-hook'.
-
-If you want to disable this, then you must set this to nil before
-`forge' is loaded.")
-
-(when forge-add-default-sections
- (magit-add-section-hook 'magit-status-sections-hook #'forge-insert-pullreqs nil t)
- (magit-add-section-hook 'magit-status-sections-hook #'forge-insert-issues nil t))
-
-;;; Add Bindings
-
-;;;###autoload
-(defvar forge-add-default-bindings t
- "Whether to add Forge's bindings to various Magit keymaps.
-
-If you want to disable this, then you must set this to nil before
-`magit' is loaded. If you do it before `forge' but after `magit'
-is loaded, then `magit-mode-map' ends up being modified anyway.")
-
-;;;###autoload
-(with-eval-after-load 'magit-mode
- (when forge-add-default-bindings
- (keymap-set magit-mode-map "'" #'forge-dispatch)
- (keymap-set magit-mode-map "N" #'forge-dispatch)
- (keymap-set magit-mode-map "<remap> <magit-browse-thing>"
- #'forge-browse)
- (keymap-set magit-mode-map "<remap> <magit-copy-thing>"
- #'forge-copy-url-at-point-as-kill)))
-
-;;;###autoload
-(with-eval-after-load 'git-commit
- (when forge-add-default-bindings
- (keymap-set git-commit-mode-map "C-c C-v" #'forge-visit-topic)))
-
-(when forge-add-default-bindings
- (keymap-set magit-commit-section-map "C-c C-v" #'forge-visit-topic)
- (keymap-set magit-branch-section-map "C-c C-v" #'forge-visit-topic)
-
- (transient-insert-suffix 'magit-dispatch "o"
- '("N" "Forge" forge-dispatch))
-
- (transient-append-suffix 'magit-fetch "m" '("n" forge-pull))
- (transient-append-suffix 'magit-fetch "n" '("N" forge-pull-notifications))
-
- (transient-append-suffix 'magit-pull "m" '("n" forge-pull))
- (transient-append-suffix 'magit-pull "n" '("N" forge-pull-notifications))
-
- (transient-append-suffix 'magit-branch "w"
- '("f" "pull-request" forge-checkout-pullreq))
- (transient-append-suffix 'magit-branch "W"
- '("F" "from pull-request" forge-branch-pullreq))
-
- (transient-suffix-put 'magit-remote 'magit-update-default-branch :key "b u")
- (transient-append-suffix 'magit-remote "b u"
- '("b r" "Rename default branch" forge-rename-default-branch))
-
- (transient-append-suffix 'magit-worktree "c"
- '("n" "pull-request worktree" forge-checkout-worktree))
-
- (transient-append-suffix 'magit-status-jump "w"
- '("Np" "Pull requests" forge-jump-to-pullreqs))
- (transient-append-suffix 'magit-status-jump "Np"
- '("Ni" "Issues" forge-jump-to-issues))
-
- (transient-append-suffix 'magit-merge "a"
- '(7 "M" "Merge using API" forge-merge)))
-
-;;; Startup Asserts
-
-(defconst forge--minimal-git "2.7.0")
-
-(defun forge-startup-asserts ()
- (let ((version (magit-git-version)))
- (when (and version (version< version forge--minimal-git))
- (display-warning 'magit (format "\
-Forge requires Git >= %s, you are using %s.
-
-If this comes as a surprise to you, because you do actually have
-a newer version installed, then that probably means that the
-older version happens to appear earlier on the `$PATH'. If you
-always start Emacs from a shell, then that can be fixed in the
-shell's init file. If you start Emacs by clicking on an icon,
-or using some sort of application launcher, then you probably
-have to adjust the environment as seen by graphical interface.
-For X11 something like ~/.xinitrc should work.
-
-If you use Tramp to work inside remote Git repositories, then you
-have to make sure a suitable Git is used on the remote machines
-too.\n" forge--minimal-git version) :error))))
-
-(if after-init-time
- (forge-startup-asserts)
- (add-hook 'after-init-hook #'forge-startup-asserts t))
-
-;;; forge.el ends here
+++ /dev/null
-This is forge.info, produced by makeinfo version 6.8 from forge.texi.
-
- Copyright (C) 2018-2024 Jonas Bernoulli
- <emacs.forgeNOSPAMjonas.bernoulli.dev>
-
- You can redistribute this document and/or modify it under the terms
- of the GNU General Public License as published by the Free Software
- Foundation, either version 3 of the License, or (at your option)
- any later version.
-
- This document is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
-INFO-DIR-SECTION Emacs
-START-INFO-DIR-ENTRY
-* Forge: (forge). Access Git Forges from Magit.
-END-INFO-DIR-ENTRY
-
-\1f
-File: forge.info, Node: Top, Next: Introduction, Up: (dir)
-
-Forge User and Developer Manual
-*******************************
-
-Forge allows you to work with Git forges, currently Github and Gitlab,
-from the comfort of Magit and Emacs.
-
-This manual is for Forge version 0.4.5.
-
- Copyright (C) 2018-2024 Jonas Bernoulli
- <emacs.forgeNOSPAMjonas.bernoulli.dev>
-
- You can redistribute this document and/or modify it under the terms
- of the GNU General Public License as published by the Free Software
- Foundation, either version 3 of the License, or (at your option)
- any later version.
-
- This document is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
-* Menu:
-
-* Introduction::
-* Initial Setup::
-* Initial Pull::
-* Getting Started::
-* Lists and Menus::
-* Visiting Topics::
-* Creating Topics and Posts::
-* Editing Topics::
-* Pulling::
-* Branching::
-* Miscellaneous Commands::
-* Miscellaneous Options::
-* How Forge Detection Works::
-* Supported Forges and Hosts::
-* FAQ::
-* Keystroke Index::
-* Function and Command Index::
-* Variable Index::
-
-— The Detailed Node Listing —
-
-Initial Setup
-
-* Setup for Github.com: Setup for Githubcom.
-* Setup for Another Github Instance::
-* Setup for Gitlab.com: Setup for Gitlabcom.
-* Setup for Another Gitlab Instance::
-* Setup a Partially Supported Host::
-
-Supported Forges and Hosts
-
-* Supported Forges::
-* Partially Supported Forges::
-* Supported Semi-Forges::
-
-FAQ
-
-* ‘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: Initial Setup, Prev: Top, Up: Top
-
-1 Introduction
-**************
-
-Forge allows you to work with Git forges, currently Github and Gitlab,
-from the comfort of Magit and Emacs.
-
- Forge fetches issues, pull-requests and other data using the forge’s
-API and stores the retrieved information in a local database.
-Additionally it fetches pull-request references using Git.
-
-\1f
-File: forge.info, Node: Initial Setup, Next: Initial Pull, Prev: Introduction, Up: Top
-
-2 Initial Setup
-***************
-
-Please first do the common setup below and then carefully follow the
-instructions for your forge instance. Once you have completed the
-setup, you can start tracking repositories (see *note Initial Pull::).
-
- If you run into difficulties during setup or the initial pull, then
-please also see *note How Forge Detection Works:: and *note
-(ghub)Getting Started::.
-
-* Menu:
-
-* Setup for Github.com: Setup for Githubcom.
-* Setup for Another Github Instance::
-* Setup for Gitlab.com: Setup for Gitlabcom.
-* Setup for Another Gitlab Instance::
-* Setup a Partially Supported Host::
-
-Common Setup
-============
-
-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)
-
- By default Forge adds some bindings to Magit keymaps and menus, and
-some sections to Magit buffers. If you would like to prevent that, you
-have to set ‘forge-add-default-bindings’ and/or
-‘forge-add-default-sections’ to ‘nil’, before ‘magit’ (not just ‘forge’)
-is loaded.
-
-\1f
-File: forge.info, Node: Setup for Githubcom, Next: Setup for Another Github Instance, Up: Initial Setup
-
-2.1 Setup for Github.com
-========================
-
-Set your Username
------------------
-
-First inform Forge about your <https://github.com> username:
-
- git config --global github.user USERNAME
-
- If you need to identify as another user in a particular repository,
-then you have to set that variable locally:
-
- cd /path/to/repo
- git config --local github.user USERNAME
-
-Create and Store an Access Token
---------------------------------
-
-Visit <https://github.com/settings/tokens> in a browser to generate a
-new "classic" token using the ‘repo’, ‘user’ and ‘read:org’ scopes. Do
-not close the browser window just yet, because the token will only be
-shown once.
-
- The built-in Auth-Source (*note (auth)Top::) package is used to store
-the token generated in the previous step. The ‘auth-sources’ variable
-controls how and where Auth-Source keeps its secrets. The default value
-is a list of three files: ‘("~/.authinfo" "~/.authinfo.gpg"
-"~/.netrc")’, but that can lead to confusing behavior, so you should
-make sure that only one of these files exists, and then you should also
-adjust the value of the variable to only ever use that file, for
-example:
-
- (setq auth-sources '("~/.authinfo"))
-
- In ‘~/.authinfo’ secrets are stored in plain text. If you don’t want
-that, then you should use the encrypted ‘~/.authinfo.gpg’ instead:
-
- (setq auth-sources '("~/.authinfo.gpg"))
-
- Make sure you put one of these forms in your init file *and* to
-evaluate it in the current Emacs instance as well, by placing the cursor
-after the final closing parenthesis and typing ‘C-x C-e’
-(‘eval-last-sexp’).
-
- Next add a line like the following to the chosen file:
-
- machine api.github.com login USERNAME^forge password TOKEN
-
- • The value of ‘machine’ must be ‘api.github.com’. Variations of
- this won’t work.
-
- • USERNAME must be the same as the value used for the ‘github.user’
- Git variable above. You *must* append ‘^forge’ to that, without
- any space in between.
-
- • TOKEN is the token you generated earlier.
-
- Finish by typing ‘M-x auth-source-forget-all-cached RET’. If you
-don’t do this, then Auth-Source may fail to look up the token.
-
-\1f
-File: forge.info, Node: Setup for Another Github Instance, Next: Setup for Gitlabcom, Prev: Setup for Githubcom, Up: Initial Setup
-
-2.2 Setup for Another Github Instance
-=====================================
-
-Before you setup a Github instance that is not <https://github.com>,
-please set that up first. The setup for <https://github.com> is easier
-and if that works, but the setup for the other Github instance fails,
-then we can tentatively narrow the issue down to the parts that differ
-between <https://github.com> and other instances.
-
-Tell Forge about the Instance
------------------------------
-
-While Forge knows about <https://github.com>, it does not know about
-your other Github instances. Forge instances are configured using the
-option ‘forge-alist’ (also see its docstring). The entry for
-<https://github.com> in that variable looks like this:
-
- ("github.com" ; GITHOST
- "api.github.com" ; APIHOST
- "github.com" ; WEBHOST and INSTANCE-ID
- forge-github-repository) ; CLASS
-
- You have to add an entry for your instance. For example, assuming
-you company uses <https://example.com>, this might be correct:
-
- (push '("example.com" ; GITHOST
- "api.example.com" ; APIHOST
- "example.com" ; WEBHOST and INSTANCE-ID
- forge-github-repository) ; CLASS
- forge-alist)
-
- Your company may use hostnames that follow a different format. You
-should be able to easily determine and verify GITHOST and WEBHOST, but
-determining APIHOST is more difficult; you might have to ask a coworker.
-APIHOST could be something like ‘api.example.com’, but it could also be
-something like ‘example.com/api’.
-
- If the REST API’s end point is ‘/v3’ and the GraphQL API’s end point
-is ‘/graphql’, then use something like ‘example.com/v3’ as APIHOST.
-This is a historic accident. See
-<https://github.com/magit/forge/issues/174>.
-
- We will use INSTANCE-ID (aka WEBHOST) and APIHOST below.
-
-Set your Username
------------------
-
-Inform Forge about your username for the Github instance in question:
-
- git config --global github.INSTANCE-ID.user USERNAME
-
- So if INSTANCE-ID is ‘example.com’ and USERNAME is ‘tarsius’ then
-use:
-
- git config --global github.example.com.user tarsius
-
-Create and Store an Access Token
---------------------------------
-
-Visit your forge in a browser. Follow a link to "Settings", from there
-to "Developer settings", from there to "Personal access tokens", and
-finally to "Tokens (classic)". On that page generate a new token using
-the ‘repo’, ‘user’ and ‘read:org’ scopes. Do not close the browser
-window just yet, because the token will only be shown once.
-
- The built-in Auth-Source (*note (auth)Top::) package is used to store
-the token generated in the previous step. The ‘auth-sources’ variable
-controls how and where Auth-Source keeps its secrets. The default value
-is a list of three files: ‘("~/.authinfo" "~/.authinfo.gpg"
-"~/.netrc")’, but that can lead to confusing behavior, so you should
-make sure that only one of these files exists, and then you should also
-adjust the value of the variable to only ever use that file, for
-example:
-
- (setq auth-sources '("~/.authinfo"))
-
- In ‘~/.authinfo’ secrets are stored in plain text. If you don’t want
-that, then you should use the encrypted ‘~/.authinfo.gpg’ instead:
-
- (setq auth-sources '("~/.authinfo.gpg"))
-
- Make sure you put one of these forms in your init file *and* to
-evaluate it in the current Emacs instance as well, by placing the cursor
-after the final closing parenthesis and typing ‘C-x C-e’
-(‘eval-last-sexp’).
-
- Next add a line like the following to the chosen file:
-
- machine APIHOST login USERNAME^forge password TOKEN
-
- • APIHOST must be the same as the second element of the entry we
- added to ‘forge-alist’. In the above example that would be
- ‘api.example.com’. Do *not* instead use GITHOST or INSTANCE-ID
- (aka WEBHOST).
-
- • USERNAME must be the same username you used above as the value of
- the Git variable. You *must* append ‘^forge’ to that, without any
- space in between.
-
- • TOKEN is the token you generated earlier.
-
- Finish by typing ‘M-x auth-source-forget-all-cached RET’. If you
-don’t do this, then Auth-Source may fail to look up the token.
-
-\1f
-File: forge.info, Node: Setup for Gitlabcom, Next: Setup for Another Gitlab Instance, Prev: Setup for Another Github Instance, Up: Initial Setup
-
-2.3 Setup for Gitlab.com
-========================
-
-Set your Username
------------------
-
-First inform Forge about your <https://gitlab.com> username:
-
- git config --global gitlab.user USERNAME
-
- If you need to identify as another user in a particular repository,
-then you have to set that variable locally:
-
- cd /path/to/repo
- git config --local gitlab.user USERNAME
-
-Create and Store an Access Token
---------------------------------
-
-Visit <https://gitlab.com/-/user_settings/personal_access_tokens> in a
-browser to generate a new token using the ‘api’, ‘read_api’ and
-‘read_user’ scopes. Do not close the browser window just yet, because
-the token will only be shown once.
-
- The built-in Auth-Source (*note (auth)Top::) package is used to store
-the token generated in the previous step. The ‘auth-sources’ variable
-controls how and where Auth-Source keeps its secrets. The default value
-is a list of three files: ‘("~/.authinfo" "~/.authinfo.gpg"
-"~/.netrc")’, but that can lead to confusing behavior, so you should
-make sure that only one of these files exists, and then you should also
-adjust the value of the variable to only ever use that file, for
-example:
-
- (setq auth-sources '("~/.authinfo"))
-
- In ‘~/.authinfo’ secrets are stored in plain text. If you don’t want
-that, then you should use the encrypted ‘~/.authinfo.gpg’ instead:
-
- (setq auth-sources '("~/.authinfo.gpg"))
-
- Make sure you put one of these forms in your init file *and* to
-evaluate it in the current Emacs instance as well, by placing the cursor
-after the final closing parenthesis and typing ‘C-x C-e’
-(‘eval-last-sexp’).
-
- Next add a line like the following to the chosen file:
-
- machine gitlab.com/api/v4 login USERNAME^forge password TOKEN
-
- • The value of ‘machine’ must be ‘gitlab.com/api/v4’. Variations of
- this won’t work.
-
- • USERNAME must be the same as the value used for the ‘gitlab.user’
- Git variable above. You *must* append ‘^forge’ to that, without
- any space in between.
-
- • TOKEN is the token you generated earlier.
-
- Finish by typing ‘M-x auth-source-forget-all-cached RET’. If you
-don’t do this, then Auth-Source may fail to look up the token.
-
-\1f
-File: forge.info, Node: Setup for Another Gitlab Instance, Next: Setup a Partially Supported Host, Prev: Setup for Gitlabcom, Up: Initial Setup
-
-2.4 Setup for Another Gitlab Instance
-=====================================
-
-Before you setup a Gitlab instance that is not <https://gitlab.com>,
-please set that up first. The setup for <https://gitlab.com> is easier
-and if that works, but the setup for the other Gitlab instance fails,
-then we can tentatively narrow the issue down to the parts that differ
-between <https://gitlab.com> and other instances.
-
-Tell Forge about the Instance
------------------------------
-
-While Forge knows about <https://gitlab.com> (and a few other well-known
-instances, see its value) it has to be taught about other Gitlab
-instances. Forge instances are configured using the option
-‘forge-alist’ (also see its docstring). The entry for
-<https://gitlab.com> in that variable looks like this:
-
- ("gitlab.com" ; GITHOST
- "gitlab.com/api/v4" ; APIHOST
- "gitlab.com" ; WEBHOST and INSTANCE-ID
- forge-gitlab-repository) ; CLASS
-
- For historic reasons, APIHOST actually has to be a host followed by a
-path.
-
- You have to add an entry for your instance. For example, assuming
-you company/organisation uses <https://example.com>, this might be
-correct:
-
- (push '("example.com" ; GITHOST
- "example.com/api/v4" ; APIHOST
- "example.com" ; WEBHOST and INSTANCE-ID
- forge-gitlab-repository) ; CLASS
- forge-alist)
-
- Your company may use hostnames that follow a different format. You
-should be able to easily determine and verify GITHOST and WEBHOST, but
-determining APIHOST is more difficult; you might have to ask a
-colleague.
-
- We will use INSTANCE-ID (aka WEBHOST) and APIHOST below.
-
-Set your Username
------------------
-
-Inform Forge about your username for the Gitlab instance in question:
-
- git config --global gitlab.INSTANCE-ID.user USERNAME
-
- So if INSTANCE-ID is ‘example.com’ and USERNAME is ‘tarsius’ then
-use:
-
- git config --global gitlab.example.com.user tarsius
-
-Create and Store an Access Token
---------------------------------
-
-Visit your forge in a browser. Follow a link to "Preferences" and from
-there to "Access Tokens". On that page generate a new "Personal access
-token" using the ‘api’, ‘read_api’ and ‘read_user’ scopes. Do not close
-the browser window just yet, because the token will only be shown once.
-
- The built-in Auth-Source (*note (auth)Top::) package is used to store
-the token generated in the previous step. The ‘auth-sources’ variable
-controls how and where Auth-Source keeps its secrets. The default value
-is a list of three files: ‘("~/.authinfo" "~/.authinfo.gpg"
-"~/.netrc")’, but that can lead to confusing behavior, so you should
-make sure that only one of these files exists, and then you should also
-adjust the value of the variable to only ever use that file, for
-example:
-
- (setq auth-sources '("~/.authinfo"))
-
- In ‘~/.authinfo’ secrets are stored in plain text. If you don’t want
-that, then you should use the encrypted ‘~/.authinfo.gpg’ instead:
-
- (setq auth-sources '("~/.authinfo.gpg"))
-
- Make sure you put one of these forms in your init file *and* to
-evaluate it in the current Emacs instance as well, by placing the cursor
-after the final closing parenthesis and typing ‘C-x C-e’
-(‘eval-last-sexp’).
-
- Next add a line like the following to the chosen file:
-
- machine APIHOST login USERNAME^forge password TOKEN
-
- • APIHOST must be the same as the second element of the entry we
- added to ‘forge-alist’. In the above example that would be
- ‘example.com/api/v4’. Do *not* instead use GITHOST or INSTANCE-ID
- (aka WEBHOST).
-
- • USERNAME must be the same username you used above as the value of
- the Git variable. You *must* append ‘^forge’ to that, without any
- space in between.
-
- • TOKEN is the token you generated earlier.
-
- Finish by typing ‘M-x auth-source-forget-all-cached RET’. If you
-don’t do this, then Auth-Source may fail to look up the token.
-
-\1f
-File: forge.info, Node: Setup a Partially Supported Host, Prev: Setup for Another Gitlab Instance, Up: Initial Setup
-
-2.5 Setup a Partially Supported Host
-====================================
-
-Forge currently only supports the Github and Gitlab APIs.
-
- It does however partially support a few additional forge types (see
-*note Partially Supported Forges::) and other lighter weight software
-used to host Git repositories, which also provide a web interfaces (see
-*note Supported Semi-Forges::). Forge doesn’t use the APIs of such
-forges, but registering the host and adding repositories to the local
-database at least enables the use of commands such as ‘forge-browse’.
-
-Tell Forge about the Instance
------------------------------
-
-A few hosts, which use partially supported forge types, are available
-out-of-the-box, because they have an entry in the default value of
-option ‘forge-alist’ (also see its docstring). For example, the entry
-for <https://github.com> in that variable looks like this:
-
- ("codeberg.org" ; GITHOST
- "codeberg.org/api/v1" ; APIHOST
- "codeberg.org" ; WEBHOST and INSTANCE-ID
- forge-gitea-repository) ; CLASS
-
- To be able to add repositories from a, so far, unknown forge instance
-to your local database, you have to add an entry for that instance to
-‘forge-alist’. For example, assuming you use another Gitea instance,
-hosted at <https://example.com>, this might be correct:
-
- (push '("example.com" ; GITHOST
- "example.com/api/v1" ; APIHOST
- "example.com" ; WEBHOST and INSTANCE-ID
- forge-gitea-repository) ; CLASS
- forge-alist)
-
- Look at ‘forge-alist’ entries of other hosts using the same forge
-type as the instance you are configuring, to see what format *might* be
-appropriate. You should be able to easily determine and verify GITHOST
-and WEBHOST, but determining APIHOST is more difficult; you might have
-to ask a colleague. APIHOST could be something like
-‘example.com/api/vi’, but it could also be something like
-‘api.example.com’.
-
-Add Support for Additional Forge Types
---------------------------------------
-
-For each fully or partially supported forge type, Forge defines at least
-a class. The following example is taken from ‘forge-semi.el’:
-
- (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\".")
-
- Once you add a host using that class to ‘forge-alist’ and then a
-repository from that host to the local database, you will be able to use
-commands such as ‘forge-browse-branch’ (but not much more).
-
- If you want to add a repository from another host, which happens to
-use another software or another URL schemata, then you might have to
-define an additional class first. See ‘forge-semi.el’ for simple
-examples and grep for ‘defclass forge-.*-repository’ for more complex
-ones.
-
-\1f
-File: forge.info, Node: Initial Pull, Next: Getting Started, Prev: Initial Setup, Up: Top
-
-3 Initial Pull
-**************
-
-To start using Forge in a certain repository, visit the Magit status
-buffer for that repository and type ‘N / a’ (‘forge-add-repository’).
-You are given a choice to pull all topics, all topics that were updated
-after a certain date, or only individual topics.
-
- Beside adding the repository to the database, this also adds a new
-value to the Git variable ‘remote.<remote>.fetch’, which causes all
-pull-request refs (‘+refs/pull/*/head:refs/pullreqs/*’ for Github) to be
-fetched by Git.
-
- Note that it is possible to use the same command to add any
-repository from a supported forge to the database, without cloning the
-Git repository first.
-
- The initial fetch can take a while but most of the work 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: Getting Started, Next: Lists and Menus, Prev: Initial Pull, Up: Top
-
-4 Getting Started
-*****************
-
-Much like Git stores information in a local repository and does not
-require a constant internet connection, Forge retrieves additional
-information using a forge’s API and stores that in a local database.
-
- Forge’s equivalent of ‘git clone’ is ‘forge-add-repository’, which
-has to be run, before most of Forges features become available in the
-local clone of a Git repository.
-
-‘N / a’ (‘forge-add-repository’)
- This command guides the user through the process of adding a
- repository to the local database.
-
- Note that it is possible to add a repository to the local database,
- without pulling all the data, which is useful if you just want to
- create a single issue or pull-request in a repository, but are not
- interested in existing topics, e.g., because you do not regularly
- contribute to that repository.
-
- Also note that you can add a repository to the local database, even
- if no local Git clone exists.
-
- Like with Git, you have to explicitly pull remote changes, at your
-leisure, using ‘forge-pull’.
-
-‘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.
-
- If the current repository isn’t being tracked in the local database
- yet, then this command pivots to behave like
- ‘forge-add-repository’.
-
- Forge adds two additional sections to Magit’s status buffer, which
-list open and/or pending issues and pull-requests. Typing ‘RET’, while
-the cursor is on a topic section, shows more information about that
-topic in a separate buffer. Typing ‘RET’ on a topic list section, shows
-that list in a separate buffer, where you can apply different filters.
-
- The other main entry point to the functionality provided by Forge is
-the ‘forge-dispatch’ menu.
-
-‘N’ (‘forge-dispatch’)
- This prefix command is available in all Magit buffers and provides
- access to most of the available Forge commands. See the following
- sections for information about the available commands.
-
-\1f
-File: forge.info, Node: Lists and Menus, Next: Visiting Topics, Prev: Getting Started, Up: Top
-
-5 Lists and Menus
-*****************
-
-Topics are listed in two sections in Magit’s status buffer, but can also
-be listed in dedicated buffers. Likewise individual topics can be
-visited in separate buffers. In both cases this can be done by placing
-the cursor on the respective section in the status buffer and typing
-‘RET’, or by invoking the appropriate command from Forge’s main menu, on
-‘N’ (‘forge-dispatch’).
-
- List commands and corresponding menu commands exist for topics,
-notifications and repositories, but there isn’t always an exclusive
-mapping from menu to buffer. The main menu (‘forge-dispatch’), the
-configuration menu (‘forge-configure’), the menu which controls the
-current topic or the topic at point (‘forge-topic-menu’), and the menu
-which controls the topics listed in the current buffer
-(‘forge-topics-menu’), are useful in more than one major mode.
-
- All of these menus feature bindings to directly switch to the other
-appropriate menus. So it is enough to remember that ‘N’ always brings
-up the dispatch menu; you can always navigate to another menu from
-there.
-
- ‘C-c C-c’ brings up the most appropriate menu for the current buffer.
-In Magit’s status buffer the most appropriate menu is Magit’s own
-dispatch menu (‘magit-dispatch’), so here the quickest way to invoke
-Forge’s dispatch menu is ‘N’. Even in Magit’s status buffer, when the
-cursor is an individual topic or on a topic list section, ‘C-c C-c’
-opens the respective menu (‘forge-topics-menu’ or ‘forge-topic-menu’).
-
- The following sections describe most of the available menu and list
-commands. For ‘forge-topic-menu’, see *note Editing Topics::.
-
-Dispatch and configuration menus
-================================
-
-‘N’ (‘forge-dispatch’)
- This prefix menu command is available in all Magit buffers and
- provides access to most of the available Forge commands. See the
- following sections for information about the available commands.
-
-‘N m c’ (‘forge-configure’)
- This command displays a menu used to configure the current
- repository and some global settings as well.
-
-Topic menu and list commands
-============================
-
-‘N m f’ (‘forge-topics-menu’)
-‘C-c C-c [in topics list buffer/section]’
- This command displays a menu used to control the list of topics
- displayed in the current buffer.
-
- Note that this command can not only be used in buffers dedicated to
- listing topics, but also in Magit’s status buffer.
-
-‘N l t’ (‘forge-list-topics’)
- This command lists the current repository’s issues in a separate
- buffer. If the list buffer already exists, this command only
- ensures that all types of topics are listed. If any other filters
- are in effect, they are left intact. TODO fix preserving type
-
-‘<RET> [on "Issues" status section]’ (‘forge-list-issues’)
- This command lists the current repository’s issues in a separate
- buffer. If the list buffer already exists, this command limits the
- list to issues. If any other filters are in effect, they are left
- intact.
-
-‘<RET> [on "Pull requests" status section]’ (‘forge-list-pullreqs’)
- This command lists the current repository’s pull-requests in a
- separate buffer. If the list buffer already exists, this command
- limits the list to pull-requests. If any other filters are in
- effect, they are left intact.
-
-‘N l g’ (‘forge-list-global-topics’)
- This command lists topics across all tracked repository. If the
- list buffer already exists, filters except for the type filter are
- left in effect.
-
- -- Command: forge-list-global-issues
- This command lists issues across all tracked repository. If the
- list buffer already exists, filters except for the type filter are
- left in effect.
-
- -- Command: forge-list-global-pullreqs
- This command lists pull-requests across all tracked repository. If
- the list buffer already exists, filters except for the type filter
- are in effect.
-
-Notification menu and list commands
-===================================
-
-‘N m n’ (‘forge-notifications-menu’)
-‘C-c C-c’
- This command displays a menu used to control the list of
- notifications displayed in the current buffer.
-
-‘N l n’ (‘forge-list-notifications’)
- This command lists all notifications for all forges in a separate
- buffer.
-
-Repository menu and list commands
-=================================
-
-‘N m r’ (‘forge-repositories-menu’)
-‘C-c C-c’
- This command displays a menu used to control the list of
- repositories displayed in the current buffer.
-
-‘N l r’ (‘forge-list-repositories’)
- This command lists all known repositories in a separate buffer.
- Here "known" means that an entry exists in the local database.
-
-‘<RET> [on repository]’ (‘forge-visit-this-repository’)
- This commands visits the repository at point in a separate buffer.
-
-‘o [in forge-repositories-menu]’ (‘forge-list-owned-repositories’)
- This command lists all known repositories that belong to the user
- in a separate buffer. Here "known" means that an entry exists in
- the local database. Only Github is supported for now.
-
- The below options controls which repositories are considered to be
-owned by the user. They are additionally used by ‘forge-fork’.
-
- -- 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.
-
- 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’.
-
-Exiting menus and lists
-=======================
-
-To exit a menu, type ‘C-g’. If the menu was invoked from another menu
-and that menu is useful in the current buffer, then that menu becomes
-active again. If that happens and you actually want to quit all menus,
-then just type ‘C-g’ again. You can also directly exit all menus by
-using ‘C-q’, instead of ‘C-g’.
-
- Type ‘q’ to quit not only the menu, but also the list or topic detail
-buffer. That binding is also available when no menu is active, in which
-case it will simply quit the buffer. When invoked from a menu, then
-this binding may return to another list buffer, in which case some menu
-may also remain active.
-
-Default topic filters
-=====================
-
- -- User Option: forge-status-buffer-default-topic-filters
- This option specifies the filters initially used to limit topics
- listed in topic list buffers.
-
- -- User Option: forge-status-buffer-default-topic-filters
- This option specifies the filters initially used to limit topics
- listed in Magit status buffers.
-
- Also see *note Topic sections in Magit status buffers::.
-
-Topic sections in Magit status buffers
-======================================
-
-Forge arranges for certain issues and pull-requests to be list in Magit
-status buffers, by adding the following functions to
-‘magit-status-sections-hook’.
-
- Which topics are listed initially is customizable using option
-‘forge-status-buffer-default-topic-filters’ and can be changed
-temporarily for the current buffer, using ‘N m f’ (‘forge-topics-menu’).
-
- -- Function: forge-insert-issues
- This function inserts a list of issues, by default a list of
- "active" issues.
-
- -- Function: forge-insert-pullreqs
- This function inserts a list of pull-requests, by default a list of
- "active" pull-requests.
-
- Forge used to provide additional functions to insert hard-coded topic
-subsets, but they were removed in favor of the more flexible approach
-described above. If you miss the removed sections, you can use the new
-‘forge-insert-topics’ helper function to define your own section
-inserter functions. See its docstring for more information.
-
- If you don’t want any topic list sections to be displayed in Magit
-status buffers, set ‘forge-add-default-sections’ to ‘nil’ before ‘magit’
-is loaded.
-
-\1f
-File: forge.info, Node: Visiting Topics, Next: Creating Topics and Posts, Prev: Lists and Menus, Up: Top
-
-6 Visiting Topics
-*****************
-
-The commands, accessible from ‘forge-topic-menu’ (on ‘C-return’), act on
-the topic at point; so this menu is useful in buffers dedicated to
-listing topics and notifications (which correspond to topics), but also
-in the status buffer (which also lists topics). In buffers dedicated to
-showing details about a single topic, these commands act on that topic;
-so this menu can be used there too.
-
- To switch to this menu from another menu use ‘m s’. If the cursor is
-on a topic or the current buffer visits a topic.
-
- To display details about a topic in a separate buffer and at the same
-time display the topic menu, invoke ‘forge-topic-menu’ with a prefix
-argument, i.e., ‘C-u RET’.
-
-‘<RET> [on topic]’ (‘forge-visit-this-topic’)
- This commands visits the topic at point in a separate buffer. When
- invoked with a prefix argument then it not only visits the topic in
- a separate buffer, it at the same time displays
-
-‘N v t’ (‘forge-visit-topic’)
-‘N v i’ (‘forge-visit-issue’)
-‘N v p’ (‘forge-visit-pullreq’)
- These commands read a topic, issue or pull-request and visit it in
- a separate buffer.
-
-‘C-c C-o’ (‘forge-browse’)
-‘o [on topic in topic list]’ (‘forge-browse-this-topic’)
-‘o [on repository in repository list]’ (‘forge-browse-this-repository’)
- These commands visit the topic, issue(s), pull-request(s), post,
- branch, commit, remote or repository at point in a browser.
-
- -- Command: forge-browse-commit
- -- Command: forge-browse-branch
- -- Command: forge-browse-repository
-‘N b t’ (‘forge-browse-topic’)
-‘N b i’ (‘forge-browse-issue’)
-‘N b p’ (‘forge-browse-pullreq’)
-‘N b r’ (‘forge-browse-remote’)
-‘N b I’ (‘forge-browse-issues’)
-‘N b P’ (‘forge-browse-pullreqs’)
- These commands read a topic, issue(s), pull-request(s), branch,
- commit, remote or repository, and open it in a browser.
-
-\1f
-File: forge.info, Node: Creating Topics and Posts, Next: Editing Topics, Prev: Visiting Topics, Up: Top
-
-7 Creating Topics and Posts
-***************************
-
-We call both issues and pull-requests "topics". The contributions to
-the conversation are called "posts". The initial topic description is
-also called a post.
-
- Creating a new topic or post and editing an existing post work
-similarly to now creating a new commit or editing the message of an
-existing commit works in Magit. 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 drop you into
-such a buffer.
-
-‘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.
-
-‘C-c C-n’ (‘forge-create-post’)
-‘C-c C-r’
- This command creates a new post on an existing topic. It is only
- available in buffers that visit an existing topic.
-
- If the region is active and marks part of an existing post, then
- that part of the post is quoted. When a prefix argument is used,
- then the complete post, which point is currently on, is quoted.
-
- 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: Editing Topics, Next: Pulling, Prev: Creating Topics and Posts, Up: Top
-
-8 Editing Topics
-****************
-
-Many details about a topic can be changed from the buffer that visits
-that topic, but also from topic lists, if the cursor is placed on the
-topic to be edited. However, to edit the posts on a topic, the topic
-has to be visited in its own buffer.
-
-‘C-c C-e [on a post section]’ (‘forge-edit-post’)
- This command visits an existing post in a separate buffer, it can
- only be invoked from a topic buffer, when the cursor is on the post
- to be edited.
-
- Editing an existing post is similar to creating a new post, as
- described in the previous section.
-
-‘C-c C-k [on a post section]’ (‘forge-delete-comment’)
- This command deletes the post the cursor is on. The initial
- message that was written when the topic was created, cannot be
- deleted, only replies to that.
-
-‘N m s’ (‘forge-topic-menu’)
-‘C-<return> [on a topic section]’
- This command displays a menu used to edit details about the topic
- the cursor is on or that is being visited in the current buffer.
- E.g., it can be used to change the status of the topic or to apply
- labels to it. Additionally it features a few commands that act on
- that topic.
-
- Details about a topic, such as its status and labels, can
-alternatively be edited by visiting the topic in its own buffer,
-navigating to the header that displays the detail and then typing ‘C-c
-C-e’. This older approach is still available, but it is usually much
-faster to use the menu.
-
-\1f
-File: forge.info, Node: Pulling, Next: Branching, Prev: Editing Topics, Up: Top
-
-9 Pulling
-*********
-
-The commands that fetch forge data are available the Forge’s main menu
-(‘forge-dispatch’ on ‘N’) and from the same menu (‘magit-fetch’ on ‘f’)
-that is used to fetch Git data. If ‘magit-pull-or-fetch’ is non-nil,
-then they are also available from the ‘magit-pull’ menu (on ‘F’).
-
- With Git you have to explicitly pull Git data to make it available in
-the local repository. Forge works the same; you have to explicitly pull
-to pull data using the forge’s API and storing in the local database.
-This is less disruptive, more reliable, familiar and easier to
-understand than if Forge pulled 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 and 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.
-
-‘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.
-
- If the current repository is still untracked locally, or the
- current repository cannot be determined, this command instead
- behaves like ‘forge-add-repository’, i.e., it adds the repository
- to the database and then performs the 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 notifications fetches associated topics even for
- repositories that you have not yet explicitly added to the local
- database.
-
-‘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. This is useful if you chose to not
- fetch all topics when you added the repository using
- ‘forge-add-repository’.
-
-\1f
-File: forge.info, Node: Branching, Next: Miscellaneous Commands, Prev: Pulling, Up: Top
-
-10 Branching
-************
-
-Forge provides commands for creating and checking out a new branch or
-work tree from a pull-request. These commands are available from the
-same transient prefix commands as the suffix commands, used to create
-and check out branches and work trees in a more generic fashion
-(‘magit-branch’ on ‘b’ and ‘magit-worktree’ on ‘%’).
-
-‘b F’ (‘forge-branch-pullreq’)
- This command creates and configures a new branch from a
- pull-request, creating and configuring a new remote if necessary.
-
- The name of the local branch is the same as the name of the remote
- branch that you are being asked to merge, unless the contributor
- could not be bothered to properly name the branch before opening
- the pull-request. The most likely such case is when you are being
- asked to merge something like "fork/master" into "origin/master".
- In such cases the local branch will be named "pr-N", where ‘N’ is
- the pull-request number.
-
- These variables are always set by this command:
-
- • ‘branch.<name>.pullRequest’ is set to the pull-request number.
- • ‘branch.<name>.pullRequestRemote’ is set to the remote on
- which the pull-request branch is located.
- • ‘branch.<name>.pushRemote’ is set to the same remote as
- ‘branch.<name>.pullRequestRemote’ if that is possible,
- otherwise it is set to the upstream remote.
- • ‘branch.<name>.description’ is set to the pull-request title.
- • ‘branch.<name>.rebase’ is set to ‘true’ because there should
- be no merge commits among the commits in a pull-request.
-
- This command also configures the upstream and the push-remote of
- the local branch that it creates.
-
- The branch against which the pull-request was opened is always used
- as the upstream. This makes it easy to see what commits you are
- being asked to merge in the section titled something like "Unmerged
- into origin/master".
-
- Like for other commands that create a branch, it depends on the
- option ‘magit-branch-prefer-remote-upstream’ whether the remote
- branch itself or the respective local branch is used as the
- upstream, so this section may also be titled, e.g., "Unmerged into
- master".
-
- When necessary and possible, the remote pull-request branch is
- configured to be used as the push-target. This makes it easy to
- see what further changes the contributor has made since you last
- reviewed their changes in the section titled something like
- "Unpulled from origin/new-feature" or "Unpulled from
- fork/new-feature".
-
- • If the pull-request branch is located in the upstream
- repository, then you probably have set ‘remote.pushDefault’ to
- that repository. However some users like to set that variable
- to their personal fork, even if they have push access to the
- upstream, so ‘branch.<name>.pushRemote’ is set anyway.
-
- • If the pull-request branch is located inside a fork, then you
- are usually able to push to that branch, because Github by
- default allows the recipient of a pull-request to push to the
- remote pull-request branch even if it is located in a fork.
- The contributor has to explicitly disable this.
-
- • If you are not allowed to push to the pull-request branch
- on the fork, then a branch by the same name located in
- the upstream repository is configured as the push-target.
-
- • A—sadly rather common—special case is when the
- contributor didn’t bother to use a dedicated branch for
- the pull-request.
-
- The most likely such case is when you are being asked to
- merge something like "fork/master" into "origin/master".
- The special push permission mentioned above is never
- granted for the branch that is the repository’s default
- branch, and that would almost certainly be the case in
- this scenario.
-
- To enable you to easily push somewhere anyway, the local
- branch is named "pr-N" (where ‘N’ is the pull-request
- number) and the upstream repository is used as the
- push-remote.
-
- • Finally, if you are allowed to push to the pull-request
- branch and the contributor had the foresight to use a
- dedicated branch, then the fork is configured as the
- push-remote.
-
- The push-remote is configured using
- ‘branch.<name>.pushRemote’, even if the used value is
- identical to that of ‘remote.pushDefault’, just in case you
- change the value of the latter later on. Additionally the
- variable ‘branch.<name>.pullRequestRemote’ is set to the
- remote on which the pull-request branch is located.
-
-‘b f’ (‘forge-checkout-pullreq’)
- This command creates and configures a new branch from a
- pull-request the same way ‘forge-branch-pullreq’ does.
- Additionally it checks out the new branch.
-
-‘Z n’ (‘forge-checkout-worktree’)
- This command creates and configures a new branch from a
- pull-request the same way ‘forge-branch-pullreq’ does.
- Additionally it checks out the new branch, using a new working
- tree.
-
- -- User Option: forge-checkout-worktree-read-directory-function
- This function is used by ‘forge-checkout-worktree’, to read the new
- worktree directory where it checks out the 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: Miscellaneous Commands, Next: Miscellaneous Options, Prev: Branching, Up: Top
-
-11 Miscellaneous Commands
-*************************
-
-‘N M’ (‘forge-merge’)
-‘m 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.
-
-‘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 - H’ (‘forge-toggle-topic-legend’)
- This command toggle whether to show a legend for faces used in
- topic menus and lists.
-
-‘N - S’ (‘forge-toggle-display-in-status-buffer’)
- This command toggles whether any topics are displayed in the
- current Magit status buffer.
-
-‘C-c C-w’ (‘forge-copy-url-at-point-as-kill’)
- This command copies the url for the topic, issue(s),
- pull-request(s), post, branch, commit, remote or repository to the
- kill-ring.
-
- This determines the url the same way as ‘forge-browse’ does, but
- then adds it to the kill-ring, instead of visiting it in a browser.
-
-‘M b r’ (‘forge-rename-default-branch’)
- This command rename the default branch to a new name read from the
- user.
-
- This changes the name on the upstream remotely and locally, and
- update the upstream remotes of local branches accordingly.
-
- -- Command: forge-add-pullreq-refspec
- This command configures 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.
-
- -- 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: Miscellaneous Options, Next: How Forge Detection Works, Prev: Miscellaneous Commands, Up: Top
-
-12 Miscellaneous Options
-************************
-
- -- User Option: forge-database-file
- This option specifies the file used to store the forge database.
-
- -- User Option: forge-topic-repository-slug-width
- This option specifies the width of repository slugs (i.e.,
- "OWNER/NAME").
-
- -- User Option: forge-buffer-draft-p
- This option controls whether new pull-requests start out as drafts
- by default.
-
- The buffer-local value of this variable is used to keep track of
- the draft status of the current pull-request.
-
- -- User Option: forge-repository-list-columns
- This option specifies the list of columns displayed when listing
- repositories.
-
- Each element has the form ‘(HEADER SOURCE WIDTH SORT PROPS)’.
-
- HEADER is the string displayed in the header. WIDTH is the width
- of the column. SOURCE is used to get the value, it has to be the
- name of a slot of ‘forge-repository’ or a function that takes such
- an object as argument. SORT is a boolean or a function used to
- sort by this column. Supported PROPS include ‘:right-align’ and
- ‘:pad-right’.
-
- -- User Option: forge-limit-topic-choices
- This option controls whether to initially limit completion
- candidates to active topics.
-
- -- User Option: forge-post-heading-format
- This option specifies the 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.
-
- -- User Option: forge-post-fill-region
- This option controls whether to call ‘fill-region’ before
- displaying forge posts.
-
- -- User Option: forge-bug-reference-hooks
- This option lists the hooks to which ‘forge-bug-reference-setup’ is
- added. It has to be customized before ‘forge’ is loaded, or it
- won’t take effect.
-
-\1f
-File: forge.info, Node: How Forge Detection Works, Next: Supported Forges and Hosts, Prev: Miscellaneous Options, Up: Top
-
-Appendix A How Forge Detection Works
-************************************
-
-Forge uses the Ghub package to communicate with forge APIs. For more
-information about Ghub, see *note (ghub)Top::.
-
- 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 is 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 variable were
-undefined. I.e., it does not fall through to try ‘origin’ if no remote
-by your chosen name exists.
-
- Once the upstream remote has been determined, Forge looks it up in
-‘forge-alist’, using the host part of the URL as the key. For example,
-the key for ‘gitNOSPAMgithub.com:magit/forge.git’ is ‘github.com’.
-
- -- User Option: forge-alist
- This option defines forge hosts known to Forge.
-
- Each entry has the form ‘(GITHOST APIHOST WEBHOST CLASS)’.
-
- • GITHOST is the host used to access repositories on the forge
- using Git.
-
- • APIHOST is the host used to access the forge’s API. For some
- forges the isn’t just a host, but a host followed by the path
- to the API’s endpoint.
-
- • WEBHOST is the host used to access repositories on this forge
- using a browser. The IDs used to identify repositories from
- the forge in the local database also derives from this value.
-
- • CLASS is the class to be used for repositories from the forge.
-
- Complications:
-
- • When connecting to a Github Enterprise edition whose REST
- API’s end point is "<host>/v3" and whose GraphQL API’s end
- point is "<host>/graphql", then use "<host>/v3" as APIHOST.
- This is a historic accident. See issue #174.
-
- • WEBHOST and CLASS cannot be changed once you have added one or
- more repositories from a forge. Changing GITHOST and/or
- APIHOST may be possible, but should seldom be necessary.
-
-\1f
-File: forge.info, Node: Supported Forges and Hosts, Next: FAQ, Prev: How Forge Detection Works, Up: Top
-
-Appendix B Supported Forges and Hosts
-*************************************
-
-Currently Forge supports two forges and three more forges partially.
-Additionally it supports four semi-forges. Support for more forges and
-semi-forges can and will be added.
-
- Both forges and semi-forges provide web interfaces for Git
-repositories. Forges additionally support pull-requests and issues and
-make those and other information available using an API.
-
- When a forge is only partially supported, then that means that only
-the functionality that does not require the API is implemented, or in
-other words, that the forge is only supported as a semi-forge.
-
- A host is a particular instance of a forge. For example the hosts
-<https://gitlab.com> and <https://salsa.debian.org> are both instances
-of the Gitlab forge. Forge supports some well known hosts out of the
-box and additional hosts can easily be supported by adding entries to
-the option ‘forge-alist’ (see *note How Forge Detection Works::).
-
- For more details about the caveats mentioned below (and some others)
-see also *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
-
-B.1 Supported Forges
-====================
-
-B.1.1 Github
-------------
-
-Forge’s support for Github can be considered the "reference
-implementation". Support for other forges can lag behind a bit.
-
-B.1.1.1 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.
-
-B.1.1.2 Github Hosts
-....................
-
- • <https://github.com>
-
-B.1.2 Gitlab
-------------
-
-B.1.2.1 Gitlab Caveats
-......................
-
- • Forge cannot provide notifications because the Gitlab API does not
- expose those.
-
-B.1.2.2 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
-
-B.2 Partially Supported Forges
-==============================
-
-B.2.1 Gitea <https://gitea.io>
-------------------------------
-
-This is the next forge whose API will be supported.
-
-B.2.1.1 Gitea Hosts
-...................
-
- • <https://codeberg.org>
-
-B.2.2 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.
-
-B.2.2.1 Gogs Hosts
-..................
-
- • <https://code.orgmode.org>
-
-B.2.3 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.
-
-B.2.3.1 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>.
-
-B.2.3.2 Bitbucket Hosts
-.......................
-
- • <https://bitbucket.org>
-
-\1f
-File: forge.info, Node: Supported Semi-Forges, Prev: Partially Supported Forges, Up: Supported Forges and Hosts
-
-B.3 Supported Semi-Forges
-=========================
-
-B.3.1 Gitweb <https://git-scm.com/docs/gitweb>
-----------------------------------------------
-
-B.3.1.1 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).
-
-B.3.2 Cgit <https://git.zx2c4.com/cgit/about>
----------------------------------------------
-
-B.3.2.1 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.
-
-B.3.2.2 Cgit Hosts
-..................
-
- • <https://git.savannah.gnu.org/cgit>
- • <https://git.kernel.org>
- • <https://repo.or.cz>
-
-B.3.3 Stgit <https://codemadness.org/git/stagit/file/README.html>
------------------------------------------------------------------
-
-B.3.3.1 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).
-
-B.3.3.2 Stgit Hosts
-...................
-
- • <https://git.suckless.org>
-
-B.3.4 Srht <https://meta.sr.ht>
--------------------------------
-
-B.3.4.1 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).
-
-B.3.4.2 Srht Hosts
-..................
-
- • <https://git.sr.ht>
-
-\1f
-File: forge.info, Node: FAQ, Next: Keystroke Index, Prev: Supported Forges and Hosts, Up: Top
-
-Appendix C FAQ
-**************
-
-This section lists some frequently asked questions. Please see also
-<https://github.com/magit/forge/wiki/FAQ> for an extended list of common
-issues.
-
-* Menu:
-
-* ‘error in process filter HTTP Error 502, "Bad gateway"’: error in process filter HTTP Error 502 "Bad gateway".
-
-\1f
-File: forge.info, Node: error in process filter HTTP Error 502 "Bad gateway", Up: FAQ
-
-C.1 ‘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.
-Unfortunately the reason given is rather vague, but I believe this
-usually happens when there are topics with one or two magnitudes more
-posts than usual, which can cause GraphQL responses to become huge.
-
- This can be countered in the affected repository by setting the Git
-variable ‘forge.graphqlItemLimit’:
-
- git config --local forge.graphqlItemLimit 20
-
- The default is specified using the ‘ghub-graphql-items-per-request’,
-which defaults to 50 (down from Github’s default and maximum of 100).
-
- Fetching less items per request results in more requests, which slows
-down the process, which is why the default should not be too small, but
-for some repositories a more aggressive limit is needed.
-
-\1f
-File: forge.info, Node: Keystroke Index, Next: Function and Command Index, Prev: FAQ, Up: Top
-
-Appendix D Keystroke Index
-**************************
-
-\0\b[index\0\b]
-* Menu:
-
-* b F: Branching. (line 13)
-* b f: Branching. (line 102)
-* C-<return> [on a topic section]: Editing Topics. (line 26)
-* C-c C-c: Lists and Menus. (line 97)
-* C-c C-c <1>: Lists and Menus. (line 109)
-* C-c C-c <2>: Creating Topics and Posts.
- (line 37)
-* C-c C-c [in topics list buffer/section]: Lists and Menus. (line 53)
-* C-c C-e: Creating Topics and Posts.
- (line 45)
-* C-c C-e d: Creating Topics and Posts.
- (line 50)
-* C-c C-e [on a post section]: Editing Topics. (line 12)
-* C-c C-k: Creating Topics and Posts.
- (line 41)
-* C-c C-k [on a post section]: Editing Topics. (line 20)
-* C-c C-n: Creating Topics and Posts.
- (line 27)
-* C-c C-n [on "Issues" section]: Creating Topics and Posts.
- (line 23)
-* C-c C-n [on "Pull requests" section]: Creating Topics and Posts.
- (line 19)
-* C-c C-o: Visiting Topics. (line 34)
-* C-c C-r: Creating Topics and Posts.
- (line 27)
-* C-c C-w: Miscellaneous Commands.
- (line 37)
-* f n: Getting Started. (line 32)
-* f n <1>: Pulling. (line 23)
-* f N: Pulling. (line 34)
-* M b r: Miscellaneous Commands.
- (line 45)
-* m M [if enabled]: Miscellaneous Commands.
- (line 8)
-* N: Getting Started. (line 50)
-* N <1>: Lists and Menus. (line 40)
-* N - H: Miscellaneous Commands.
- (line 29)
-* N - S: Miscellaneous Commands.
- (line 33)
-* N / a: Getting Started. (line 15)
-* N b i: Visiting Topics. (line 46)
-* N b I: Visiting Topics. (line 46)
-* N b p: Visiting Topics. (line 46)
-* N b P: Visiting Topics. (line 46)
-* N b r: Visiting Topics. (line 46)
-* N b t: Visiting Topics. (line 46)
-* N c f: Miscellaneous Commands.
- (line 21)
-* N c i: Creating Topics and Posts.
- (line 23)
-* N c p: Creating Topics and Posts.
- (line 19)
-* N f f: Getting Started. (line 32)
-* N f f <1>: Pulling. (line 23)
-* N f n: Pulling. (line 34)
-* N f t: Pulling. (line 43)
-* N l g: Lists and Menus. (line 78)
-* N l n: Lists and Menus. (line 101)
-* N l r: Lists and Menus. (line 113)
-* N l t: Lists and Menus. (line 60)
-* N M: Miscellaneous Commands.
- (line 8)
-* N m c: Lists and Menus. (line 45)
-* N m f: Lists and Menus. (line 53)
-* N m n: Lists and Menus. (line 97)
-* N m r: Lists and Menus. (line 109)
-* N m s: Editing Topics. (line 26)
-* N r: How Forge Detection Works.
- (line 83)
-* N v i: Visiting Topics. (line 28)
-* N v p: Visiting Topics. (line 28)
-* N v t: Visiting Topics. (line 28)
-* o [in forge-repositories-menu]: Lists and Menus. (line 120)
-* o [on repository in repository list]: Visiting Topics. (line 34)
-* o [on topic in topic list]: Visiting Topics. (line 34)
-* RET [on "Issues" status section]: Lists and Menus. (line 66)
-* RET [on "Pull requests" status section]: Lists and Menus. (line 72)
-* RET [on repository]: Lists and Menus. (line 117)
-* RET [on topic]: Visiting Topics. (line 21)
-* Z n: Branching. (line 107)
-
-\1f
-File: forge.info, Node: Function and Command Index, Next: Variable Index, Prev: Keystroke Index, Up: Top
-
-Appendix E Function and Command Index
-*************************************
-
-\0\b[index\0\b]
-* Menu:
-
-* forge-add-organization-repositories: Miscellaneous Commands.
- (line 64)
-* forge-add-pullreq-refspec: Miscellaneous Commands.
- (line 51)
-* forge-add-repository: Getting Started. (line 15)
-* forge-add-user-repositories: Miscellaneous Commands.
- (line 58)
-* forge-branch-pullreq: Branching. (line 13)
-* forge-browse: Visiting Topics. (line 34)
-* forge-browse-branch: Visiting Topics. (line 38)
-* forge-browse-commit: Visiting Topics. (line 37)
-* forge-browse-issue: Visiting Topics. (line 46)
-* forge-browse-issues: Visiting Topics. (line 46)
-* forge-browse-pullreq: Visiting Topics. (line 46)
-* forge-browse-pullreqs: Visiting Topics. (line 46)
-* forge-browse-remote: Visiting Topics. (line 46)
-* forge-browse-repository: Visiting Topics. (line 39)
-* forge-browse-this-repository: Visiting Topics. (line 34)
-* forge-browse-this-topic: Visiting Topics. (line 34)
-* forge-browse-topic: Visiting Topics. (line 46)
-* forge-checkout-pullreq: Branching. (line 102)
-* forge-checkout-worktree: Branching. (line 107)
-* forge-configure: Lists and Menus. (line 45)
-* forge-copy-url-at-point-as-kill: Miscellaneous Commands.
- (line 37)
-* forge-create-issue: Creating Topics and Posts.
- (line 23)
-* forge-create-post: Creating Topics and Posts.
- (line 27)
-* forge-create-pullreq: Creating Topics and Posts.
- (line 19)
-* forge-delete-comment: Editing Topics. (line 20)
-* forge-dispatch: Getting Started. (line 50)
-* forge-dispatch <1>: Lists and Menus. (line 40)
-* forge-edit-post: Editing Topics. (line 12)
-* forge-forge.remote: How Forge Detection Works.
- (line 83)
-* forge-fork: Miscellaneous Commands.
- (line 21)
-* forge-insert-issues: Lists and Menus. (line 184)
-* forge-insert-pullreqs: Lists and Menus. (line 188)
-* forge-list-global-issues: Lists and Menus. (line 82)
-* forge-list-global-pullreqs: Lists and Menus. (line 87)
-* forge-list-global-topics: Lists and Menus. (line 78)
-* forge-list-issues: Lists and Menus. (line 66)
-* forge-list-notifications: Lists and Menus. (line 101)
-* forge-list-owned-repositories: Lists and Menus. (line 120)
-* forge-list-pullreqs: Lists and Menus. (line 72)
-* forge-list-repositories: Lists and Menus. (line 113)
-* forge-list-topics: Lists and Menus. (line 60)
-* forge-merge: Miscellaneous Commands.
- (line 8)
-* forge-notifications-menu: Lists and Menus. (line 97)
-* forge-post-cancel: Creating Topics and Posts.
- (line 41)
-* forge-post-dispatch: Creating Topics and Posts.
- (line 45)
-* forge-post-submit: Creating Topics and Posts.
- (line 37)
-* forge-post-toggle-draft: Creating Topics and Posts.
- (line 50)
-* forge-pull: Getting Started. (line 32)
-* forge-pull <1>: Pulling. (line 23)
-* forge-pull-notifications: Pulling. (line 34)
-* forge-pull-topic: Pulling. (line 43)
-* forge-remove-repository: Miscellaneous Commands.
- (line 71)
-* forge-remove-topic-locally: Miscellaneous Commands.
- (line 75)
-* forge-rename-default-branch: Miscellaneous Commands.
- (line 45)
-* forge-repositories-menu: Lists and Menus. (line 109)
-* forge-reset-database: Miscellaneous Commands.
- (line 85)
-* forge-toggle-display-in-status-buffer: Miscellaneous Commands.
- (line 33)
-* forge-toggle-topic-legend: Miscellaneous Commands.
- (line 29)
-* forge-topic-menu: Editing Topics. (line 26)
-* forge-topics-menu: Lists and Menus. (line 53)
-* forge-visit-issue: Visiting Topics. (line 28)
-* forge-visit-pullreq: Visiting Topics. (line 28)
-* forge-visit-this-repository: Lists and Menus. (line 117)
-* forge-visit-this-topic: Visiting Topics. (line 21)
-* forge-visit-topic: Visiting Topics. (line 28)
-
-\1f
-File: forge.info, Node: Variable Index, Prev: Function and Command Index, Up: Top
-
-Appendix F Variable Index
-*************************
-
-\0\b[index\0\b]
-* Menu:
-
-* forge-alist: How Forge Detection Works.
- (line 95)
-* forge-buffer-draft-p: Miscellaneous Options.
- (line 13)
-* forge-bug-reference-hooks: Miscellaneous Options.
- (line 50)
-* forge-checkout-worktree-read-directory-function: Branching. (line 112)
-* forge-database-file: Miscellaneous Options.
- (line 6)
-* forge-limit-topic-choices: Miscellaneous Options.
- (line 33)
-* forge-owned-accounts: Lists and Menus. (line 127)
-* forge-owned-ignored: Lists and Menus. (line 140)
-* forge-post-fill-region: Miscellaneous Options.
- (line 46)
-* forge-post-heading-format: Miscellaneous Options.
- (line 37)
-* forge-repository-list-columns: Miscellaneous Options.
- (line 20)
-* forge-status-buffer-default-topic-filters: Lists and Menus. (line 163)
-* forge-status-buffer-default-topic-filters <1>: Lists and Menus.
- (line 167)
-* forge-topic-repository-slug-width: Miscellaneous Options.
- (line 9)
-* forge.remote: How Forge Detection Works.
- (line 69)
-
-
-\1f
-Tag Table:
-Node: Top\7f771
-Node: Introduction\7f2507
-Node: Initial Setup\7f2928
-Ref: Common Setup\7f3633
-Node: Setup for Githubcom\7f4227
-Ref: Set your Username\7f4388
-Ref: Create and Store an Access Token\7f4718
-Node: Setup for Another Github Instance\7f6586
-Ref: Tell Forge about the Instance\7f7134
-Ref: Set your Username (1)\7f8680
-Ref: Create and Store an Access Token (1)\7f8988
-Node: Setup for Gitlabcom\7f11089
-Ref: Set your Username (2)\7f11292
-Ref: Create and Store an Access Token (2)\7f11622
-Node: Setup for Another Gitlab Instance\7f13513
-Ref: Tell Forge about the Instance (1)\7f14074
-Ref: Set your Username (3)\7f15415
-Ref: Create and Store an Access Token (3)\7f15723
-Node: Setup a Partially Supported Host\7f17775
-Ref: Tell Forge about the Instance (2)\7f18460
-Ref: Add Support for Additional Forge Types\7f19956
-Node: Initial Pull\7f21127
-Node: Getting Started\7f22334
-Node: Lists and Menus\7f24620
-Ref: Dispatch and configuration menus\7f26444
-Ref: Topic menu and list commands\7f26903
-Ref: Notification menu and list commands\7f28840
-Ref: Repository menu and list commands\7f29217
-Ref: Exiting menus and lists\7f30984
-Ref: Default topic filters\7f31679
-Ref: Topic sections in Magit status buffers\7f32119
-Node: Visiting Topics\7f33350
-Node: Creating Topics and Posts\7f35464
-Node: Editing Topics\7f37546
-Node: Pulling\7f39171
-Node: Branching\7f41333
-Node: Miscellaneous Commands\7f47726
-Node: Miscellaneous Options\7f51450
-Node: How Forge Detection Works\7f53535
-Node: Supported Forges and Hosts\7f59072
-Node: Supported Forges\7f60381
-Ref: Github\7f60537
-Ref: Github Caveats\7f60692
-Ref: Github Hosts\7f61354
-Ref: Gitlab\7f61426
-Ref: Gitlab Caveats\7f61453
-Ref: Gitlab Hosts\7f61594
-Node: Partially Supported Forges\7f61730
-Ref: Gitea https//giteaio\7f61936
-Ref: Gitea Hosts\7f62052
-Ref: Gogs https//gogsio\7f62124
-Ref: Gogs Hosts\7f62343
-Ref: Bitbucket https//bitbucketorg\7f62417
-Ref: Bitbucket Caveats\7f62631
-Ref: Bitbucket Hosts\7f63544
-Node: Supported Semi-Forges\7f63625
-Ref: Gitweb https//git-scmcom/docs/gitweb\7f63796
-Ref: Gitweb Caveats\7f63891
-Ref: Cgit https//gitzx2c4com/cgit/about\7f64147
-Ref: Cgit Caveats\7f64240
-Ref: Cgit Hosts\7f64605
-Ref: Stgit https//codemadnessorg/git/stagit/file/READMEhtml\7f64748
-Ref: Stgit Caveats\7f64881
-Ref: Stgit Hosts\7f65183
-Ref: Srht https//metasrht\7f65259
-Ref: Srht Caveats\7f65324
-Ref: Srht Hosts\7f65623
-Node: FAQ\7f65690
-Node: error in process filter HTTP Error 502 "Bad gateway"\7f66100
-Node: Keystroke Index\7f67581
-Node: Function and Command Index\7f73561
-Node: Variable Index\7f79841
-\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 (do not edit) -*- lexical-binding: t -*-
+;; Generated by the `loaddefs-generate' function.
+
+;; This file is part of GNU Emacs.
+
+;;; Code:
+
+(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
+
+
+\f
+;;; Generated autoloads from forge.el
+
+(defvar forge-add-default-bindings t "\
+Whether to add Forge's bindings to various Magit keymaps.
+
+If you want to disable this, then you must set this to nil before
+`magit' is loaded. If you do it before `forge' but after `magit'
+is loaded, then `magit-mode-map' ends up being modified anyway.")
+(with-eval-after-load 'magit-mode (when forge-add-default-bindings (keymap-set magit-mode-map "'" #'forge-dispatch) (keymap-set magit-mode-map "N" #'forge-dispatch) (keymap-set magit-mode-map "<remap> <magit-browse-thing>" #'forge-browse) (keymap-set magit-mode-map "<remap> <magit-copy-thing>" #'forge-copy-url-at-point-as-kill)))
+(with-eval-after-load 'magit-repos (when forge-add-default-bindings (keymap-set magit-repolist-mode-map "N" #'forge-dispatch)))
+(with-eval-after-load 'git-commit (when forge-add-default-bindings (keymap-set git-commit-mode-map "C-c C-v" #'forge-visit-topic)))
+(register-definition-prefixes "forge" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-bitbucket.el
+
+(register-definition-prefixes "forge-bitbucket" '("forge-bitbucket-repository"))
+
+\f
+;;; Generated autoloads from forge-commands.el
+
+(autoload 'forge-dispatch "forge-commands" nil t)
+(autoload 'forge-configure "forge-commands" nil t)
+(autoload 'forge-pull "forge-commands" nil t)
+(autoload 'forge-pull-notifications "forge-commands" nil t)
+(autoload 'forge-pull-topic "forge-commands" nil t)
+(autoload 'forge-pull-this-topic "forge-commands" nil t)
+(autoload 'forge-browse-issues "forge-commands" "\
+Visit the current repository's issues using a browser." t)
+(autoload 'forge-browse-pullreqs "forge-commands" "\
+Visit the current repository's pull-requests using a browser." t)
+(autoload 'forge-browse-topic "forge-commands" "\
+Read a TOPIC and visit it using a browser.
+By default only offer open topics but with a prefix argument
+also offer closed topics.
+
+(fn TOPIC)" t)
+(autoload 'forge-browse-issue "forge-commands" "\
+Read an ISSUE and visit it using a browser.
+By default only offer open issues but with a prefix argument
+also offer closed issues.
+
+(fn ISSUE)" t)
+(autoload 'forge-browse-pullreq "forge-commands" "\
+Read a PULL-REQUEST and visit it using a browser.
+By default only offer open pull-requests but with a prefix
+argument also offer closed pull-requests.
+
+(fn PULL-REQUEST)" t)
+(autoload 'forge-browse-commit "forge-commands" "\
+Read a COMMIT and visit it using a browser.
+
+(fn COMMIT)" t)
+(autoload 'forge-browse-branch "forge-commands" "\
+Read a BRANCH and visit it using a browser.
+
+(fn BRANCH)" t)
+(autoload 'forge-browse-remote "forge-commands" "\
+Read a REMOTE and visit it using a browser.
+
+(fn REMOTE)" t)
+(autoload 'forge-browse-repository "forge-commands" "\
+Read a REPOSITORY and visit it using a browser.
+
+(fn REPOSITORY)" t)
+(autoload 'forge-browse-this-topic "forge-commands" nil t)
+(autoload 'forge-browse-this-repository "forge-commands" "\
+Visit the repository at point using a browser." t)
+(autoload 'forge-copy-url-at-point-as-kill "forge-commands" "\
+Copy the url of the thing at point." t)
+(autoload 'forge-browse "forge-commands" "\
+Visit the thing at point using a browser." t)
+(autoload 'forge-visit-topic "forge-commands" "\
+Read a TOPIC and visit it.
+By default only offer active topics for completion. With a prefix
+argument offer all topics. While completion is in progress, \\<forge-read-topic-minibuffer-map>\\[forge-read-topic-lift-limit] lifts
+the limitation to active topics.
+
+(fn TOPIC)" t)
+(autoload 'forge-visit-issue "forge-commands" "\
+Read an ISSUE and visit it.
+By default only offer active issues for completion. With a prefix
+argument offer all topics. While completion is in progress, \\<forge-read-topic-minibuffer-map>\\[forge-read-topic-lift-limit] lifts
+the limitation to active issues.
+
+(fn ISSUE)" t)
+(autoload 'forge-visit-pullreq "forge-commands" "\
+Read a PULL-REQUEST and visit it.
+By default only offer active pull-requests for completion. With a
+prefix argument offer all topics. While completion is in progress,
+\\<forge-read-topic-minibuffer-map>\\[forge-read-topic-lift-limit] lifts the limitation to active pull-requests.
+
+(fn PULL-REQUEST)" t)
+(autoload 'forge-visit-this-topic "forge-commands" "\
+Visit the topic at point.
+With prefix argument MENU, also show the topic menu.
+
+(fn &optional MENU)" t)
+(autoload 'forge-visit-this-repository "forge-commands" "\
+Visit the repository at point." t)
+(autoload 'forge-branch-pullreq "forge-commands" "\
+Create and configure a new branch from a pull-request.
+Please see the manual for more information.
+
+(fn PULLREQ)" t)
+(autoload 'forge-checkout-pullreq "forge-commands" "\
+Create, configure and checkout a new branch from a pull-request.
+Please see the manual for more information.
+
+(fn PULLREQ)" t)
+(autoload 'forge-checkout-this-pullreq "forge-commands" nil t)
+(autoload 'forge-checkout-worktree "forge-commands" "\
+Create, configure and checkout a new worktree from a pull-request.
+This is like `forge-checkout-pullreq', except that it also
+creates a new worktree. Please see the manual for more
+information.
+
+(fn PATH PULLREQ)" t)
+(autoload 'forge-fork "forge-commands" "\
+Fork the current repository to FORK and add it as a REMOTE.
+If the fork already exists, then that isn't an error; the remote
+is added anyway. Currently this only supports Github and Gitlab.
+
+(fn FORK REMOTE)" t)
+(autoload 'forge-merge "forge-commands" nil t)
+(autoload 'forge-rename-default-branch "forge-commands" "\
+Rename the default branch to NEWNAME.
+Change the name on the upstream remotely and locally, and update the
+upstream remotes of local branches accordingly." t)
+(autoload 'forge-add-pullreq-refspec "forge-commands" nil t)
+(autoload 'forge-add-repository "forge-commands" nil t)
+(autoload 'forge-add-user-repositories "forge-commands" "\
+Add all of USER's repositories from HOST to the database.
+This may take a while. Only Github is supported at the moment.
+
+(fn HOST USER)" t)
+(autoload 'forge-add-organization-repositories "forge-commands" "\
+Add all of ORGANIZATION's repositories from HOST to the database.
+This may take a while. Only Github is supported at the moment.
+
+(fn HOST ORGANIZATION)" t)
+(autoload 'forge-remove-repository "forge-commands" "\
+Remove a repository from the database.
+
+(fn REPOSITORY)" t)
+(autoload 'forge-remove-topic-locally "forge-commands" "\
+Remove a topic from the local database only.
+Due to how the supported APIs work, it would be too expensive to
+automatically remove topics from the local database that were
+removed from the forge. The purpose of this command is to allow
+you to manually clean up the local database.
+
+(fn TOPIC)" t)
+(autoload 'forge-reset-database "forge-commands" "\
+Move the current database file to the trash.
+This is useful after the database scheme has changed, which will
+happen a few times while the forge functionality is still under
+heavy development." t)
+(register-definition-prefixes "forge-commands" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-core.el
+
+(register-definition-prefixes "forge-core" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-db.el
+
+(register-definition-prefixes "forge-db" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-gitea.el
+
+(register-definition-prefixes "forge-gitea" '("forge-gitea-repository"))
+
+\f
+;;; Generated autoloads from forge-github.el
+
+(register-definition-prefixes "forge-github" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-gitlab.el
+
+(register-definition-prefixes "forge-gitlab" '("forge-gitlab-repository"))
+
+\f
+;;; Generated autoloads from forge-gogs.el
+
+(register-definition-prefixes "forge-gogs" '("forge-gogs-repository"))
+
+\f
+;;; Generated autoloads from forge-issue.el
+
+(register-definition-prefixes "forge-issue" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-notify.el
+
+(autoload 'forge-list-notifications "forge-notify" nil t)
+(register-definition-prefixes "forge-notify" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-post.el
+
+(register-definition-prefixes "forge-post" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-pullreq.el
+
+(register-definition-prefixes "forge-pullreq" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-repo.el
+
+(register-definition-prefixes "forge-repo" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-repos.el
+
+(autoload 'forge-repositories-menu "forge-repos" nil t)
+(autoload 'forge-list-repositories "forge-repos" nil t)
+(autoload 'forge-list-owned-repositories "forge-repos" nil t)
+(register-definition-prefixes "forge-repos" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-revnote.el
+
+(register-definition-prefixes "forge-revnote" '("forge-revnote"))
+
+\f
+;;; Generated autoloads from forge-semi.el
+
+(register-definition-prefixes "forge-semi" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-tablist.el
+
+(register-definition-prefixes "forge-tablist" '("forge--tab"))
+
+\f
+;;; Generated autoloads from forge-topic.el
+
+(autoload 'forge-topic-menu "forge-topic" nil t)
+(autoload 'forge-topic-state-menu "forge-topic" nil t)
+(autoload 'forge-topic-status-menu "forge-topic" nil t)
+(register-definition-prefixes "forge-topic" '("forge-"))
+
+\f
+;;; Generated autoloads from forge-topics.el
+
+(autoload 'forge-topics-menu "forge-topics" nil t)
+(autoload 'forge-list-topics "forge-topics" nil t)
+(autoload 'forge-list-issues "forge-topics" nil t)
+(autoload 'forge-list-pullreqs "forge-topics" nil t)
+(autoload 'forge-list-global-topics "forge-topics" nil t)
+(autoload 'forge-list-global-issues "forge-topics" nil t)
+(autoload 'forge-list-global-pullreqs "forge-topics" nil t)
+(register-definition-prefixes "forge-topics" '("forge-"))
+\f
+;;; End of scraped data
+
+(provide 'forge-autoloads)
+
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; no-native-compile: t
+;; coding: utf-8-emacs-unix
+;; End:
+
+;;; forge-autoloads.el ends here
--- /dev/null
+;;; forge-bitbucket.el --- Bitbucket support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'buck)
+(require 'forge)
+
+;;; Class
+
+(defclass forge-bitbucket-repository (forge-noapi-repository)
+ ((issues-url-format :initform "https://%h/%o/%n/issues")
+ (issue-url-format :initform "https://%h/%o/%n/issues/%i")
+ ;; The anchor for the issue itself is .../%i#issue-%i
+ (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#comment-%I")
+ (pullreqs-url-format :initform "https://%h/%o/%n/pull-requests")
+ (pullreq-url-format :initform "https://%h/%o/%n/pull-requests/%i")
+ (pullreq-post-url-format :initform "https://%h/%o/%n/pull-requests/%i#comment-%I")
+ (commit-url-format :initform "https://%h/%o/%n/commits/%r")
+ (branch-url-format :initform "https://%h/%o/%n/branch/%r")
+ (remote-url-format :initform "https://%h/%o/%n/src")
+ (create-issue-url-format :initform "https://%h/%o/%n/issues/new")
+ (create-pullreq-url-format :initform "https://%h/%o/%n/pull-requests/new")))
+
+;;; _
+(provide 'forge-bitbucket)
+;;; forge-bitbucket.el ends here
--- /dev/null
+;;; forge-commands.el --- Commands -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'forge)
+
+;;; Options
+
+(defcustom forge-add-pullreq-refspec t
+ "Whether the pull-request refspec is added when setting up a repository.
+
+This controls whether running `forge-pull' for the first time in
+a repository also adds a refspec that fetches all pull-requests.
+In repositories with huge numbers of pull-requests you might want
+to not do so, in which case you should set this option to `ask'.
+
+You can also set this to nil and later add the refspec explicitly
+for a repository using the command `forge-add-pullreq-refspec'."
+ :package-version '(forge . "0.2.0")
+ :group 'forge
+ :type '(choice (const :tag "Always add refspec" t)
+ (const :tag "Ask every time" ask)
+ (const :tag "Never add refspec" nil)))
+
+(defcustom forge-checkout-worktree-read-directory-function
+ 'forge-checkout-worktree-default-read-directory-function
+ "Function used by `forge-checkout-worktree' to read worktree directory.
+Takes the pull-request as only argument and must return a directory."
+ :package-version '(forge . "0.4.0")
+ :group 'forge
+ :type 'function)
+
+;;; Dispatch
+
+;;;###autoload(autoload 'forge-dispatch "forge-commands" nil t)
+(transient-define-prefix forge-dispatch ()
+ "Dispatch a forge command."
+ :transient-non-suffix #'transient--do-call
+ :refresh-suffixes t
+ :environment #'forge--menu-environment
+ :column-widths forge--topic-menus-column-widths
+ [forge--topic-menus-group
+ ["Fetch"
+ ("f f" "all topics" forge-pull)
+ ("f t" "one topic" forge-pull-topic)
+ ("f n" "notifications" forge-pull-notifications)]
+ ["Create"
+ :if forge--get-repository:tracked?
+ ("c i" "issue" forge-create-issue)
+ ("c p" "pull-request" forge-create-pullreq)
+ ("c u" "pr from issue" forge-create-pullreq-from-issue)
+ ("c f" "fork or remote" forge-fork)]
+ [:description (lambda ()
+ (cond
+ ((forge--get-repository:tracked?) "Actions")
+ ((or (magit-gitdir) (forge-repository-at-point))
+ "Forge does not yet track this repository")
+ ("Not inside a Git repository")))
+ ("/a" forge-add-repository
+ :description (lambda () (let ((repo (forge-get-repository :stub?)))
+ (if (or (not repo)
+ (eq (oref repo condition) :tracked))
+ "track some repo"
+ "track this repository"))))
+ ("/M" "merge with api" forge-merge
+ :if forge--get-repository:tracked? :level 7)]]
+ [forge--lists-group
+ ["Visit"
+ :inapt-if-not forge--get-repository:tracked?
+ ("v t" "topic" forge-visit-topic)
+ ("v i" "issue" forge-visit-issue)
+ ("v p" "pull-request" forge-visit-pullreq)]
+ ["Browse"
+ ("b t" "topic" forge-browse-topic
+ :inapt-if-not forge--get-repository:tracked?)
+ ("b i" "issue" forge-browse-issue
+ :inapt-if-not forge--get-repository:tracked?)
+ ("b p" "pull-request" forge-browse-pullreq
+ :inapt-if-not forge--get-repository:tracked?)
+ ("b r" "remote" forge-browse-remote)
+ ("b I" "issues" forge-browse-issues)
+ ("b P" "pull-requests" forge-browse-pullreqs)
+ ""]
+ ["Display"
+ ("-S" forge-toggle-display-in-status-buffer
+ :inapt-if-not forge--buffer-with-topics-sections-p)
+ ("-H" forge-toggle-topic-legend)]]
+ [forge--topic-legend-group])
+
+(transient-augment-suffix forge-dispatch
+ :transient #'transient--do-replace
+ :inapt-if (lambda () (eq (oref transient--prefix command) 'forge-dispatch))
+ :inapt-face 'forge-suffix-active)
+
+;;;###autoload(autoload 'forge-configure "forge-commands" nil t)
+(transient-define-prefix forge-configure ()
+ "Configure current repository and global settings."
+ :transient-non-suffix #'transient--do-call
+ :refresh-suffixes t
+ :environment #'forge--menu-environment
+ :column-widths forge--topic-menus-column-widths
+ [forge--topic-menus-group
+ ["Configure"
+ ("R " forge-add-pullreq-refspec)
+ ("s r" forge-forge.remote)
+ ("s l" forge-forge.graphqlItemLimit)]])
+
+(transient-augment-suffix forge-configure
+ :transient #'transient--do-replace
+ :inapt-if (lambda () (eq (oref transient--prefix command) 'forge-configure))
+ :inapt-face 'forge-suffix-active)
+
+;;; Pull
+
+;;;###autoload(autoload 'forge-pull "forge-commands" nil t)
+(transient-define-suffix forge-pull ()
+ "Pull forge topics for the current repository if it is already tracked.
+If the current repository is still untracked locally, or the current
+repository cannot be determined, instead invoke `forge-add-repository'."
+ :description (lambda ()
+ (if (forge-get-repository :tracked?)
+ "forge topics"
+ "new forge repository"))
+ (declare (interactive-only nil))
+ (interactive)
+ (if-let ((repo (forge-get-repository :tracked?)))
+ (forge--pull repo)
+ (transient-setup 'forge-add-repository nil nil
+ :scope (forge-add-repository--scope))))
+
+(defun forge-read-date (prompt)
+ (require (quote org) nil)
+ (if (fboundp 'org-read-date)
+ (org-read-date nil nil nil prompt)
+ (cl-block nil
+ (while t
+ (let ((str (read-from-minibuffer prompt)))
+ (cond ((string-equal str "")
+ (cl-return nil))
+ ((string-match-p
+ "\\`[0-9]\\{4\\}[-/][0-9]\\{2\\}[-/][0-9]\\{2\\}\\'" str)
+ (cl-return str))))
+ (message "Please enter a date in the format YYYY-MM-DD.")
+ (sit-for 1)))))
+
+(cl-defmethod forge--pull ((repo forge-noapi-repository) &rest _)
+ (forge--msg repo t t "Pulling from REPO is not supported"))
+
+(cl-defmethod forge--pull ((repo forge-unusedapi-repository) &rest _)
+ (magit-git-fetch (oref repo remote) (magit-fetch-arguments)))
+
+(defun forge--maybe-git-fetch (repo &optional buffer)
+ (if (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (if (and (derived-mode-p 'magit-mode)
+ (forge-repository-equal (forge-get-repository :stub?) repo)
+ (magit-toplevel))
+ (magit-git-fetch (oref repo remote) (magit-fetch-arguments))
+ (magit-refresh-buffer)))
+ (when-let ((worktree (forge-get-worktree repo)))
+ (let ((default-directory worktree)
+ (magit-inhibit-refresh t))
+ (magit-git-fetch (oref repo remote) (magit-fetch-arguments))))))
+
+;;;###autoload(autoload 'forge-pull-notifications "forge-commands" nil t)
+(transient-define-suffix forge-pull-notifications ()
+ "Fetch notifications for all repositories from the current forge."
+ :description "forge notifications"
+ (interactive)
+ (if-let ((repo (forge-get-repository :stub?)))
+ (let ((class (eieio-object-class repo)))
+ (if (eq class 'forge-github-repository)
+ (forge--pull-notifications class (oref repo githost))
+ (user-error "Fetching notifications not supported for forge %S"
+ (oref repo forge))))
+ (forge--pull-notifications 'forge-github-repository "github.com")))
+
+;;;###autoload(autoload 'forge-pull-topic "forge-commands" nil t)
+(transient-define-suffix forge-pull-topic (number)
+ "Read a topic TYPE and NUMBER pull data about it from its forge."
+ :inapt-if-not (lambda () (and (forge--get-repository:tracked?)
+ (forge--get-github-repository)))
+ (interactive
+ (list (read-number "Pull topic: "
+ (and-let* ((topic (forge-current-topic)))
+ (oref topic number)))))
+ (forge--pull-topic (forge-get-repository :tracked) number))
+
+;;;###autoload(autoload 'forge-pull-this-topic "forge-commands" nil t)
+(transient-define-suffix forge-pull-this-topic ()
+ "Pull data about the topic at point from its forge."
+ :inapt-if-not #'forge--get-github-repository
+ :description "fetch"
+ (interactive)
+ (let ((topic (forge-current-topic t)))
+ (forge--pull-topic (forge-get-repository topic) topic)))
+
+(cl-defmethod forge--pull-topic ((repo forge-repository) _topic)
+ (error "Fetching an individual topic not implemented for %s"
+ (eieio-object-class repo)))
+
+;;; Browse
+
+;;;###autoload
+(defun forge-browse-issues ()
+ "Visit the current repository's issues using a browser."
+ (interactive)
+ (browse-url (forge--format (forge-get-repository :stub)
+ 'issues-url-format)))
+
+;;;###autoload
+(defun forge-browse-pullreqs ()
+ "Visit the current repository's pull-requests using a browser."
+ (interactive)
+ (browse-url (forge--format (forge-get-repository :stub)
+ 'pullreqs-url-format)))
+
+;;;###autoload
+(defun forge-browse-topic (topic)
+ "Read a TOPIC and visit it using a browser.
+By default only offer open topics but with a prefix argument
+also offer closed topics."
+ (interactive (list (forge-read-topic "Browse topic")))
+ (forge--browse-topic topic))
+
+;;;###autoload
+(defun forge-browse-issue (issue)
+ "Read an ISSUE and visit it using a browser.
+By default only offer open issues but with a prefix argument
+also offer closed issues."
+ (interactive (list (forge-read-issue "Browse issue")))
+ (forge--browse-topic issue))
+
+;;;###autoload
+(defun forge-browse-pullreq (pull-request)
+ "Read a PULL-REQUEST and visit it using a browser.
+By default only offer open pull-requests but with a prefix
+argument also offer closed pull-requests."
+ (interactive (list (forge-read-pullreq "Browse pull-request")))
+ (forge--browse-topic pull-request))
+
+(defun forge--browse-topic (topic)
+ (let ((obj (forge-get-topic topic)))
+ (browse-url (forge-get-url obj))
+ (forge-topic-mark-read obj)))
+
+;;;###autoload
+(defun forge-browse-commit (commit)
+ "Read a COMMIT and visit it using a browser."
+ (interactive
+ (list (or (magit-completing-read "Browse commit"
+ (magit-list-branch-names)
+ nil nil nil 'magit-revision-history
+ (magit-branch-or-commit-at-point))
+ (user-error "Nothing selected"))))
+ (browse-url (forge-get-url :commit commit)))
+
+;;;###autoload
+(defun forge-browse-branch (branch)
+ "Read a BRANCH and visit it using a browser."
+ (interactive (list (magit-read-branch "Browse branch")))
+ (browse-url (forge-get-url :branch branch)))
+
+;;;###autoload
+(defun forge-browse-remote (remote)
+ "Read a REMOTE and visit it using a browser."
+ (interactive (list (magit-read-remote "Browse remote" nil t)))
+ (browse-url (forge-get-url :remote remote)))
+
+;;;###autoload
+(defun forge-browse-repository (repository)
+ "Read a REPOSITORY and visit it using a browser."
+ (interactive (list (forge-read-repository "Browse repository")))
+ (browse-url (forge-get-url repository)))
+
+;;;###autoload(autoload 'forge-browse-this-topic "forge-commands" nil t)
+(transient-define-suffix forge-browse-this-topic ()
+ "Visit the topic at point using a browser."
+ :description "browse"
+ (interactive)
+ (forge-browse-topic (forge-current-topic t)))
+
+;;;###autoload
+(defun forge-browse-this-repository ()
+ "Visit the repository at point using a browser."
+ (interactive)
+ (forge-browse-repository (forge-repository-at-point t)))
+
+;;;###autoload
+(defun forge-copy-url-at-point-as-kill ()
+ "Copy the url of the thing at point."
+ (interactive)
+ (if-let ((target (forge--browse-target)))
+ (let ((url (if (stringp target) target (forge-get-url target))))
+ (kill-new url)
+ (message "Copied \"%s\"" url))
+ (user-error "Nothing at point with a URL")))
+
+;;;###autoload
+(defun forge-browse ()
+ "Visit the thing at point using a browser."
+ (interactive)
+ (if-let ((target (forge--browse-target)))
+ (if (stringp target)
+ (browse-url target)
+ (browse-url (forge-get-url target))
+ (when (cl-typep target 'forge-topic)
+ (forge-topic-mark-read target)))
+ (user-error "Nothing to browse here")))
+
+(defun forge--browse-target ()
+ (or (and-let* ((branch (magit--painted-branch-at-point)))
+ (forge-get-url :branch branch))
+ (and-let* ((commit (magit-commit-at-point)))
+ (forge-get-url :commit commit))
+ (and-let* ((branch (magit-branch-at-point)))
+ (forge-get-url :branch branch))
+ (and-let* ((remote (magit-remote-at-point)))
+ (forge-get-url :remote remote))
+ (forge-post-at-point)
+ (forge-current-topic)
+ (and magit-buffer-revision
+ (forge-get-url :commit magit-buffer-revision))
+ (forge-get-repository :stub?)))
+
+;;;; Urls
+
+(cl-defgeneric forge-get-url (obj)
+ "Return the URL for a forge object.")
+
+(cl-defmethod forge-get-url ((issue forge-issue))
+ (forge--format issue 'issue-url-format))
+
+(cl-defmethod forge-get-url ((pullreq forge-pullreq))
+ (forge--format pullreq 'pullreq-url-format))
+
+(cl-defmethod forge-get-url ((repo forge-repository))
+ (forge--format repo 'remote-url-format))
+
+(cl-defmethod forge-get-url ((_(eql :commit)) commit)
+ (let ((repo (forge-get-repository :stub)))
+ (unless (magit-list-containing-branches
+ commit "-r" (concat (oref repo remote) "/*"))
+ (if-let* ((branch (car (magit-list-containing-branches commit "-r")))
+ (remote (car (magit-split-branch-name branch))))
+ (setq repo (forge-get-repository :stub remote))
+ (message "%s does not appear to be available on any remote. %s"
+ commit "You might have to push it first.")))
+ (forge--format repo 'commit-url-format
+ `((?r . ,(magit-commit-p commit))))))
+
+(cl-defmethod forge-get-url ((_(eql :branch)) branch)
+ (let (remote)
+ (if (magit-remote-branch-p branch)
+ (pcase-setq `(,remote . ,branch) (magit-split-branch-name branch))
+ (unless (setq remote (or (magit-get-push-remote branch)
+ (magit-get-upstream-remote branch)))
+ (user-error "Cannot determine remote for %s" branch)))
+ (forge--format (forge-get-repository :stub remote)
+ 'branch-url-format
+ `((?r . ,branch)))))
+
+(cl-defmethod forge-get-url ((_(eql :remote)) remote)
+ (forge--format (forge-get-repository :stub remote) 'remote-url-format))
+
+(cl-defmethod forge-get-url ((post forge-post))
+ (forge--format post (let ((topic (forge-get-parent post)))
+ (cond ((forge--childp topic 'forge-issue)
+ 'issue-post-url-format)
+ ((forge--childp topic 'forge-pullreq)
+ 'pullreq-post-url-format)))))
+
+(cl-defmethod forge-get-url ((notify forge-notification))
+ (oref notify url))
+
+;;; Visit
+
+;;;###autoload
+(defun forge-visit-topic (topic)
+ "Read a TOPIC and visit it.
+By default only offer active topics for completion. With a prefix
+argument offer all topics. While completion is in progress, \
+\\<forge-read-topic-minibuffer-map>\\[forge-read-topic-lift-limit] lifts
+the limitation to active topics."
+ (interactive (list (forge-read-topic "View topic")))
+ (forge-topic-setup-buffer (forge-get-topic topic)))
+
+;;;###autoload
+(defun forge-visit-issue (issue)
+ "Read an ISSUE and visit it.
+By default only offer active issues for completion. With a prefix
+argument offer all topics. While completion is in progress, \
+\\<forge-read-topic-minibuffer-map>\\[forge-read-topic-lift-limit] lifts
+the limitation to active issues."
+ (interactive (list (forge-read-issue "View issue")))
+ (forge-topic-setup-buffer (forge-get-issue issue)))
+
+;;;###autoload
+(defun forge-visit-pullreq (pull-request)
+ "Read a PULL-REQUEST and visit it.
+By default only offer active pull-requests for completion. With a
+prefix argument offer all topics. While completion is in progress,
+\\<forge-read-topic-minibuffer-map>\\[forge-read-topic-lift-limit] \
+lifts the limitation to active pull-requests."
+ (interactive (list (forge-read-pullreq "View pull-request")))
+ (forge-topic-setup-buffer (forge-get-pullreq pull-request)))
+
+;;;###autoload
+(defun forge-visit-this-topic (&optional menu)
+ "Visit the topic at point.
+With prefix argument MENU, also show the topic menu."
+ (interactive (list current-prefix-arg))
+ (forge-topic-setup-buffer (forge-topic-at-point))
+ (cond
+ ((eq transient-current-command 'forge-topic-menu)
+ (setq forge--quit-keep-topic-menu t))
+ ((or menu
+ (memq transient-current-command
+ '(forge-topics-menu forge-notifications-menu)))
+ (transient-setup 'forge-topic-menu))))
+
+;;;###autoload
+(defun forge-visit-this-repository ()
+ "Visit the repository at point."
+ (interactive)
+ (let* ((repo (forge-repository-at-point))
+ (worktree (forge-get-worktree repo)))
+ (cond
+ ((and (eq transient-current-command 'forge-repositories-menu)
+ (forge-get-repository repo nil :tracked?))
+ (if-let ((buffer (get-buffer (forge-topics-buffer-name repo))))
+ (progn (switch-to-buffer buffer)
+ (transient-setup 'forge-topics-menu))
+ (forge-list-topics repo)))
+ (worktree
+ (magit-status-setup-buffer worktree))
+ ((forge-get-repository repo nil :tracked?)
+ (forge-list-topics repo))
+ ((user-error "Not tracked and location of clone is unknown")))))
+
+;;; Create
+
+(defun forge-create-issue ()
+ "Create a new issue for the current repository."
+ (interactive)
+ (let* ((repo (forge-get-repository :tracked))
+ (buf (forge--prepare-post-buffer
+ "new-issue"
+ (forge--format repo "Create new issue on %p"))))
+ (when buf
+ (with-current-buffer buf
+ (setq forge--buffer-post-object repo)
+ (setq forge--submit-post-function #'forge--submit-create-issue))
+ (forge--display-post-buffer buf))))
+
+(defun forge-create-pullreq (source target)
+ "Create a new pull-request for the current repository."
+ (interactive (forge-create-pullreq--read-args))
+ (let* ((repo (forge-get-repository :tracked))
+ (buf (forge--prepare-post-buffer
+ "new-pullreq"
+ (forge--format repo "Create new pull-request on %p")
+ source target)))
+ (with-current-buffer buf
+ (setq forge--buffer-base-branch target)
+ (setq forge--buffer-head-branch source)
+ (setq forge--buffer-post-object repo)
+ (setq forge--submit-post-function #'forge--submit-create-pullreq)
+ (run-hooks 'forge-create-pullreq-hook))
+ (forge--display-post-buffer buf)))
+
+(transient-define-suffix forge-create-pullreq-from-issue (issue source target)
+ "Convert an existing ISSUE into a pull-request."
+ :description "convert to pull-request"
+ :if (lambda ()
+ (and (forge--get-github-repository)
+ (let ((issue (forge-current-issue)))
+ (and issue (eq (oref issue state) 'open)
+ issue))))
+ (interactive (cons (forge-read-open-issue "Convert issue")
+ (forge-create-pullreq--read-args)))
+ (setq issue (forge-get-issue issue))
+ (forge--create-pullreq-from-issue (forge-get-repository issue)
+ issue source target))
+
+(defun forge-create-pullreq--read-args ()
+ (let* ((source (magit-completing-read
+ "Source branch"
+ (magit-list-remote-branch-names)
+ nil t nil 'magit-revision-history
+ (or (and-let* ((d (magit-branch-at-point)))
+ (if (magit-remote-branch-p d)
+ d
+ (magit-get-push-branch d t)))
+ (and-let* ((d (magit-get-current-branch)))
+ (if (magit-remote-branch-p d)
+ d
+ (magit-get-push-branch d t))))))
+ (repo (forge-get-repository :tracked))
+ (remote (oref repo remote))
+ (targets (delete source (magit-list-remote-branch-names remote)))
+ (target (magit-completing-read
+ "Target branch" targets nil t nil 'magit-revision-history
+ (let* ((d (cdr (magit-split-branch-name source)))
+ (d (and (magit-branch-p d) d))
+ (d (and d (magit-get-upstream-branch d)))
+ (d (and d (if (magit-remote-branch-p d)
+ d
+ (magit-get-upstream-branch d))))
+ (d (or d (concat remote "/"
+ (or (oref repo default-branch)
+ "master")))))
+ (car (member d targets))))))
+ (list source target)))
+
+(defun forge-create-post (&optional quote)
+ "Create a new post on an existing topic.
+If the region is active, then quote that part of the post.
+Otherwise and with a prefix argument quote the post that
+point is currently on."
+ (interactive (list current-prefix-arg))
+ (unless (derived-mode-p 'forge-topic-mode)
+ (user-error "This command is only available from topic buffers"))
+ (let* ((topic forge-buffer-topic)
+ (buf (forge--prepare-post-buffer
+ (forge--format topic "%i;new-comment")
+ (forge--format topic "New comment on #%i of %p")))
+ (quote (cond
+ ((not (magit-section-match 'post)) nil)
+ ((use-region-p)
+ (buffer-substring-no-properties (region-beginning)
+ (region-end)))
+ (quote
+ (let ((section (magit-current-section)))
+ (string-trim-right
+ (buffer-substring-no-properties (oref section content)
+ (oref section end))))))))
+ (with-current-buffer buf
+ (setq forge--buffer-post-object topic)
+ (setq forge--submit-post-function #'forge--submit-create-post)
+ (when quote
+ (goto-char (point-max))
+ (unless (bobp)
+ (insert "\n"))
+ (insert (replace-regexp-in-string "^" "> " quote) "\n\n")))
+ (forge--display-post-buffer buf)))
+
+;;; Edit
+
+(defun forge-edit-post ()
+ "Edit the current post."
+ (interactive)
+ (let* ((post (forge-post-at-point t))
+ (buf (cl-typecase post
+ (forge-topic
+ (forge--prepare-post-buffer
+ (forge--format post "%i")
+ (forge--format post "Edit #%i of %p")))
+ (forge-post
+ (forge--prepare-post-buffer
+ (forge--format post "%i;%I")
+ (forge--format post "Edit comment on #%i of %p"))))))
+ (with-current-buffer buf
+ (setq forge--buffer-post-object post)
+ (setq forge--submit-post-function #'forge--submit-edit-post)
+ (erase-buffer)
+ (when (cl-typep post 'forge-topic)
+ (insert "# " (oref post title) "\n\n"))
+ (insert (oref post body)))
+ (forge--display-post-buffer buf)))
+
+(transient-define-suffix forge-edit-topic-note ()
+ "Edit your private note about the current topic."
+ :transient #'transient--do-quit-all
+ :description
+ (lambda ()
+ (if-let ((topic (forge-current-topic)))
+ (concat "note "
+ (if-let ((note (oref topic note)))
+ (propertize (substring note 0 (string-match-p "$" note))
+ 'face 'font-lock-string-face)
+ (propertize "none" 'face 'magit-dimmed)))
+ "note"))
+ (interactive)
+ (if-let* ((topic (forge-current-topic t))
+ (repo (forge-get-repository topic))
+ (default-directory (forge-get-worktree repo))
+ (buf (forge--prepare-post-buffer
+ (forge--format topic "%i;note")
+ (forge--format topic "New note on #%i of %p"))))
+ (progn
+ (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))
+ (message "Cannot determine topic or worktree")))
+
+;;; Delete
+
+(transient-define-suffix forge-delete-comment ()
+ "Delete the comment at point."
+ :description "delete comment"
+ :inapt-if-not #'forge-comment-at-point
+ (interactive)
+ (let ((comment (forge-comment-at-point t)))
+ (when (yes-or-no-p "Really delete the current comment? ")
+ (forge--delete-comment (forge-get-repository :tracked) comment))))
+
+;;; Branch
+
+;;;###autoload
+(defun forge-branch-pullreq (pullreq)
+ "Create and configure a new branch from a pull-request.
+Please see the manual for more information."
+ (interactive (list (forge-read-pullreq "Branch pull request")))
+ (let ((pullreq (forge-get-pullreq pullreq)))
+ (if-let ((branch (forge--pullreq-branch-active pullreq)))
+ (progn (message "Branch %S already exists and is configured" branch)
+ branch)
+ (forge--branch-pullreq (forge-get-repository pullreq) pullreq)
+ (forge-refresh-buffer))))
+
+(cl-defmethod forge--branch-pullreq ((pullreq forge-pullreq))
+ (forge--branch-pullreq (forge-get-repository pullreq) pullreq))
+
+(cl-defmethod forge--branch-pullreq ((_repo forge-unusedapi-repository) pullreq)
+ ;; We don't know enough to do a good job.
+ (let* ((number (oref pullreq number))
+ (branch (format "pr-%s" number)))
+ (when (magit-branch-p branch)
+ (user-error "Branch `%s' already exists" branch))
+ (magit-git "branch" branch (forge--pullreq-ref pullreq))
+ ;; More often than not this is the correct target branch.
+ (magit-call-git "branch" branch "--set-upstream-to=master")
+ (magit-set (number-to-string number) "branch" branch "pullRequest")
+ branch))
+
+(cl-defmethod forge--branch-pullreq ((repo forge-repository) pullreq)
+ (let* ((number (oref pullreq number))
+ (branch-n (format "pr-%s" number))
+ (branch (or (forge--pullreq-branch-internal pullreq) branch-n))
+ (pullreq-ref (format "refs/pullreqs/%s" number)))
+ (cond ((and-let* ((pr-branch (oref pullreq head-ref)))
+ (string-search ":" pr-branch))
+ ;; Such a branch name would be invalid. If we encounter
+ ;; it anyway, then that means that the source branch and
+ ;; the merge-request ref are missing. Luckily Gitlab no
+ ;; longer does this, but we nevertheless have to deal
+ ;; with merge-requests that have been lost in time.
+ (error "Cannot check out this merge-request because %s"
+ "on old Gitlab version discarded the source branch"))
+ ((not (eq (oref pullreq state) 'open))
+ (magit-git "branch" "--force" branch pullreq-ref))
+ (t
+ (let ((upstream (oref repo remote))
+ (pr-remote (oref pullreq head-user))
+ (pr-branch (oref pullreq head-ref)))
+ (cond ((not (oref pullreq cross-repo-p))
+ (let ((tracking (concat upstream "/" pr-branch)))
+ (unless (magit-branch-p tracking)
+ (magit-call-git "fetch" upstream))
+ (forge--setup-pullreq-branch branch tracking)
+ (magit-branch-maybe-adjust-upstream branch tracking)
+ (magit-set upstream "branch" branch "pushRemote")
+ (magit-set upstream "branch" branch "pullRequestRemote")))
+ ((not pr-branch)
+ ;; The pullreq branch (on Github) has been deleted.
+ (setq pr-remote nil)
+ (setq branch branch-n)
+ (forge--setup-pullreq-branch branch pullreq-ref)
+ (magit-set upstream "branch" branch "pushRemote"))
+ (t
+ ;; For prs within the upstream we are more permissive,
+ ;; but any request to merge a branch with a well known
+ ;; name from fork, is highly suspicious and likely the
+ ;; result of a contributor not bothering to name their
+ ;; feature branch.
+ (when (and (member branch magit-main-branch-names)
+ (magit-branch-p branch))
+ (setq branch branch-n))
+ (forge--setup-pullreq-remote pullreq)
+ (forge--setup-pullreq-branch
+ branch (concat pr-remote "/" pr-branch))
+ (if (and (oref pullreq editable-p)
+ (equal branch pr-branch))
+ (magit-set pr-remote "branch" branch "pushRemote")
+ (magit-set upstream "branch" branch "pushRemote"))))
+ (when pr-remote
+ (magit-set pr-remote "branch" branch "pullRequestRemote"))
+ (magit-set "true" "branch" branch "rebase")
+ (magit-git "branch" branch
+ (let ((base-ref (oref pullreq base-ref)))
+ (concat "--set-upstream-to="
+ (if (or magit-branch-prefer-remote-upstream
+ (not (magit-branch-p base-ref)))
+ (concat upstream "/" base-ref)
+ base-ref)))))))
+ (magit-set (number-to-string number) "branch" branch "pullRequest")
+ (magit-set (oref pullreq title) "branch" branch "description")
+ branch))
+
+(defun forge--setup-pullreq-branch (branch tracking)
+ (if (magit-branch-p branch)
+ (unless (magit-rev-equal branch tracking)
+ (message "Existing branch %s diverged from %s" branch tracking))
+ (magit-git "branch" branch tracking)))
+
+(defun forge--setup-pullreq-remote (pullreq)
+ (let* ((pr-remote (oref pullreq head-user))
+ (pr-branch (oref pullreq head-ref))
+ (repo (forge-get-repository pullreq))
+ (host (oref repo githost))
+ (user (oref pullreq head-user))
+ (fork (oref pullreq head-repo)))
+ (if (magit-remote-p pr-remote)
+ (let ((url (magit-git-string "remote" "get-url" pr-remote))
+ (fetch (magit-get-all "remote" pr-remote "fetch")))
+ (unless (equal (forge--split-forge-url url)
+ (list host user (substring fork (1+ (length user)))))
+ (user-error "Remote `%s' already exists but does not point to %s"
+ pr-remote url))
+ (unless (or (member (format "+refs/heads/*:refs/remotes/%s/*"
+ pr-remote)
+ fetch)
+ (member (format "+refs/heads/%s:refs/remotes/%s/%s"
+ pr-branch pr-remote pr-branch)
+ fetch))
+ (magit-git "remote" "set-branches" "--add" pr-remote pr-branch)
+ (magit-git "fetch" pr-remote)))
+ (let ((url (magit-git-string "remote" "get-url" (oref repo remote))))
+ (magit-git
+ "remote" "add" "-f" "--no-tags"
+ "-t" pr-branch pr-remote
+ (cond ((or (string-prefix-p "git@" url)
+ (string-prefix-p "ssh://git@" url))
+ (format "git@%s:%s.git" host fork))
+ ((string-prefix-p "https://" url)
+ (format "https://%s/%s.git" host fork))
+ ((string-prefix-p "git://" url)
+ (format "git://%s/%s.git" host fork))
+ ((string-prefix-p "http://" url)
+ (format "http://%s/%s.git" host fork))
+ ((error "%s has an unexpected format" url))))))))
+
+;;;###autoload
+(defun forge-checkout-pullreq (pullreq)
+ "Create, configure and checkout a new branch from a pull-request.
+Please see the manual for more information."
+ (interactive (list (forge-read-pullreq "Checkout pull request")))
+ (magit--checkout (forge--branch-pullreq (forge-get-pullreq pullreq)))
+ (forge-refresh-buffer))
+
+;;;###autoload(autoload 'forge-checkout-this-pullreq "forge-commands" nil t)
+(transient-define-suffix forge-checkout-this-pullreq ()
+ "Checkout the current pull-request.
+If the branch for that pull-request does not exist yet, then create and
+configure it first."
+ :description "checkout"
+ :inapt-if-not #'forge-current-pullreq
+ (interactive)
+ (forge-checkout-pullreq (forge-current-topic t)))
+
+;;;###autoload
+(defun forge-checkout-worktree (path pullreq)
+ "Create, configure and checkout a new worktree from a pull-request.
+This is like `forge-checkout-pullreq', except that it also
+creates a new worktree. Please see the manual for more
+information."
+ (interactive
+ (let ((id (forge-read-pullreq "Checkout pull request")))
+ (list (funcall forge-checkout-worktree-read-directory-function
+ (forge-get-pullreq id))
+ id)))
+ (when (and (file-exists-p path)
+ (not (and (file-directory-p path)
+ (length= (directory-files path) 2))))
+ (user-error "%s already exists and isn't empty" path))
+ (magit-worktree-checkout path
+ (forge--branch-pullreq (forge-get-pullreq pullreq))))
+
+(defun forge-checkout-worktree-default-read-directory-function (pullreq)
+ (pcase-let* (((eieio number head-ref) pullreq)
+ (path (read-directory-name
+ (format "Checkout #%s in new worktree: " number)
+ (file-name-directory
+ (directory-file-name default-directory))
+ nil nil
+ (let ((branch (forge--pullreq-branch-internal pullreq)))
+ (if (string-match-p "\\`pr-[0-9]+\\'" branch)
+ (number-to-string number)
+ (format "%s-%s" number
+ (string-replace "/" "-" head-ref)))))))
+ (when (equal path "")
+ (user-error "The empty string isn't a valid path"))
+ path))
+
+;;; Marks
+
+(defun forge-create-mark (name face description)
+ "Define a new mark that topics can be marked with."
+ (interactive
+ (list (read-string "Name: ")
+ (magit-read-char-case "Set appearance using " nil
+ (?n "a face [n]ame"
+ (read-face-name "Face name: "))
+ (?s "face [s]exp"
+ (read-from-minibuffer
+ "Face sexp: "
+ "(:background \"\" :foreground \"\" :box t)"
+ read-expression-map t)))
+ (let ((str (read-string "Description: ")))
+ (and (not (equal str "")) str))))
+ (forge-sql [:insert-into mark :values $v1]
+ (vector nil (forge--uuid) name face description)))
+
+(defun forge-edit-mark (id name face description)
+ "Define a new mark that topics can be marked with."
+ (interactive
+ (pcase-let*
+ ((marks (forge-sql [:select [name id face description] :from mark]))
+ (`(,name ,id ,face ,description)
+ (assoc (completing-read "Edit mark" (mapcar #'car marks) nil t)
+ marks)))
+ (list id
+ (read-string "Name: " name)
+ (magit-read-char-case "Set appearance using " nil
+ (?n "a face [n]ame"
+ (read-face-name "Face name: " (and (symbolp face) face)))
+ (?s "face [s]exp"
+ (read-from-minibuffer
+ "Face sexp: "
+ (if (listp face)
+ (format "%S" face)
+ "(:background \"\" :foreground \"\" :box t)")
+ read-expression-map t)))
+ (let ((str (read-string "Description: " nil nil description)))
+ (and (not (equal str "")) str)))))
+ (forge-sql [:update mark
+ :set (= [name face description] $v1)
+ :where (= id $s2)]
+ (vector name face description) id))
+
+;;; Remotely
+
+;;;###autoload
+(defun forge-fork (fork remote)
+ "Fork the current repository to FORK and add it as a REMOTE.
+If the fork already exists, then that isn't an error; the remote
+is added anyway. Currently this only supports Github and Gitlab."
+ (interactive
+ (let ((fork (magit-completing-read "Fork to"
+ (mapcar #'car forge-owned-accounts))))
+ (list fork
+ (read-string "Remote name: "
+ (or (plist-get (cdr (assoc fork forge-owned-accounts))
+ 'remote-name)
+ fork)))))
+ (let ((repo (forge-get-repository :stub)))
+ (forge--fork-repository repo fork)
+ (magit-remote-add remote
+ (magit-clone--format-url (oref repo githost) fork
+ (oref repo name))
+ (list "--fetch"))))
+
+;;;###autoload(autoload 'forge-merge "forge-commands" nil t)
+(transient-define-suffix forge-merge (pullreq method)
+ "Merge the current pull-request using METHOD using the forge's API.
+
+If there is no current pull-request or with a prefix argument,
+then read pull-request PULLREQ to visit instead.
+
+Use of this command is discouraged. Unless the remote repository
+is configured to disallow that, you should instead merge locally
+and then push the target branch. Forges detect that you have
+done that and respond by automatically marking the pull-request
+as merged."
+ (interactive
+ (list (forge-read-pullreq "Merge pull-request")
+ (if (forge--childp (forge-get-repository :tracked)
+ 'forge-gitlab-repository)
+ (magit-read-char-case "Merge method " t
+ (?m "[m]erge" 'merge)
+ (?s "[s]quash" 'squash))
+ (magit-read-char-case "Merge method " t
+ (?m "[m]erge" 'merge)
+ (?s "[s]quash" 'squash)
+ (?r "[r]ebase" 'rebase)))))
+ (let ((pullreq (forge-get-pullreq pullreq)))
+ (forge--merge-pullreq (forge-get-repository pullreq)
+ pullreq
+ (magit-rev-hash
+ (forge--pullreq-branch-internal pullreq))
+ method))
+ (forge-pull))
+
+;;;###autoload
+(defun forge-rename-default-branch ()
+ "Rename the default branch to NEWNAME.
+Change the name on the upstream remotely and locally, and update the
+upstream remotes of local branches accordingly."
+ (interactive)
+ (let* ((repo (forge-get-repository :tracked?))
+ (_ (unless (forge-github-repository-p repo)
+ (user-error "Updating default branch not supported for forge `%s'"
+ (oref repo forge))))
+ (remote (or (and (fboundp 'forge--get-remote)
+ (forge--get-remote))
+ (magit-get-some-remote)
+ (user-error "No remote configured")))
+ (symref (format "refs/remotes/%s/HEAD" remote))
+ (oldhead (progn
+ (message "Determining old default branch...")
+ (magit-git "fetch" "--prune")
+ (magit-git "remote" "set-head" "--auto" remote)
+ (message "Determining old default branch...done")
+ (magit-git-string "symbolic-ref" "--short" symref)))
+ (oldname (if oldhead
+ (cdr (magit-split-branch-name oldhead))
+ (error "Cannot determine old default branch")))
+ (default (and (not (equal oldname "main")) "main"))
+ (newname (read-string
+ (format "Rename default branch `%s' to%s: "
+ oldname
+ (if default (format " (default: %s)" default) ""))
+ nil nil default)))
+ (message "Renaming default branch...")
+ (forge--set-default-branch repo newname oldname)
+ (forge-refresh-buffer)
+ (message "Renaming default branch...done")))
+
+;;; Configuration
+
+(transient-define-suffix forge-forge.remote ()
+ "Change the local value of the `forge.remote' Git variable."
+ :class 'magit--git-variable:choices
+ :variable "forge.remote"
+ :choices #'magit-list-remotes
+ :default (lambda (_) (forge--get-remote t t))
+ (interactive)
+ (let ((obj (transient-suffix-object)))
+ (transient-infix-set obj (transient-infix-read obj)))
+ (if (and transient--prefix
+ (eq (oref transient--prefix command) 'forge-add-repository))
+ ;; Improvements to Transient will make this hack unnecessary.
+ (let ((scope (forge-add-repository--scope)))
+ (oset (transient-prefix-object) scope scope))
+ (transient--show)))
+
+(transient-define-infix forge-forge.graphqlItemLimit ()
+ "Change the maximum number of GraphQL entities to pull at once."
+ :if #'forge--get-github-repository
+ :class 'magit--git-variable
+ :variable "forge.graphqlItemLimit"
+ :reader #'read-string
+ :default (lambda () (number-to-string ghub-graphql-items-per-request)))
+
+(transient-define-suffix forge-toggle-display-in-status-buffer ()
+ "Toggle whether to display topics in the current status buffer."
+ :if-mode 'magit-status-mode
+ :inapt-if-not #'forge--buffer-with-topics-sections-p
+ :description (lambda ()
+ (if (and forge--buffer-topics-spec
+ (oref forge--buffer-topics-spec type))
+ "hide topics"
+ "display topics"))
+ (interactive)
+ (oset forge--buffer-topics-spec type
+ (if (oref forge--buffer-topics-spec type) nil 'topic))
+ (forge-refresh-buffer))
+
+(defun forge--buffer-with-topics-sections-p ()
+ (and forge--buffer-topics-spec
+ (not (eq major-mode 'forge-topics-mode))
+ (forge-get-repository :tracked?)))
+
+;;;###autoload(autoload 'forge-add-pullreq-refspec "forge-commands" nil t)
+(transient-define-suffix forge-add-pullreq-refspec ()
+ "Configure Git to fetch all pull-requests.
+This is done by adding \"+refs/pull/*/head:refs/pullreqs/*\"
+to the value of `remote.REMOTE.fetch', where REMOTE is the
+upstream remote."
+ :if-not 'forge--pullreq-refspec
+ :description "add pull-request refspec"
+ (interactive)
+ (let* ((repo (forge-get-repository :stub))
+ (remote (oref repo remote))
+ (fetch (magit-get-all "remote" remote "fetch"))
+ (refspec (oref repo pullreq-refspec)))
+ (if (member refspec fetch)
+ (message "Pull-request refspec is already active")
+ (magit-call-git "config" "--add"
+ (format "remote.%s.fetch" remote)
+ refspec)
+ (magit-git-fetch remote (magit-fetch-arguments)))))
+
+(defun forge--pullreq-refspec ()
+ (let* ((repo (forge-get-repository :stub))
+ (remote (oref repo remote))
+ (fetch (magit-get-all "remote" remote "fetch"))
+ (refspec (oref repo pullreq-refspec)))
+ (car (member refspec fetch))))
+
+;;; Add repositories
+
+;;;###autoload(autoload 'forge-add-repository "forge-commands" nil t)
+(transient-define-prefix forge-add-repository (&optional repo limit)
+ "Add a repository to the database."
+ :refresh-suffixes t
+ [:class transient-subgroups
+
+ ;; Already tracked.
+ [:if (lambda () (forge--scope :tracked))
+ (:info*
+ (lambda ()
+ (format
+ (propertize "%s is already being tracked" 'face 'transient-heading)
+ (propertize (forge--scope 'url) 'face 'bold)))
+ :format "%d")]
+
+ ;; Nothing to tracked.
+ [:if-not (lambda () (forge--scope 'topdir))
+ (:info*
+ (lambda ()
+ (format
+ (propertize "%s is not inside a Git repository" 'face 'transient-heading)
+ (propertize default-directory 'face 'bold)))
+ :format "%d")]
+
+ ;; Cannot track.
+ [:if (lambda () (and (not (forge--scope 'repo)) (forge--scope 'topdir)))
+ :description
+ (lambda ()
+ (concat
+ (format (propertize "Cannot determine forge host for %s\n"
+ 'face 'transient-heading)
+ (propertize (forge--scope 'topdir) 'face 'bold))
+ (if-let* ((remote (forge--get-remote))
+ (url (magit-git-string "remote" "get-url" remote)))
+ (format (propertize "because %s is not on a host known to Forge."
+ 'face 'transient-heading)
+ (propertize url 'face 'bold))
+ (propertize "because no suitable remote was detected."
+ 'face 'transient-heading))))
+ ("r" forge-forge.remote :format " %k Try another %d %v" :face 'bold)
+ ("h" "Learn how to configure another Github host"
+ (lambda () (interactive) (info "(forge)Setup for Another Github Instance")))
+ ("l" "Learn how to configure another Gitlab host"
+ (lambda () (interactive) (info "(forge)Setup for Another Gitlab Instance")))
+ ("p" "Learn how to configure partially supported host"
+ (lambda () (interactive) (info "(forge)Setup a Partially Supported Host")))]
+
+ ;; Track it!
+ [:if (lambda () (forge--scope :untracked))
+ :description
+ (lambda ()
+ (format
+ (propertize "Adding %s to database," 'face 'transient-heading)
+ (propertize (forge--scope 'url) 'face 'bold)))
+ ("r" forge-forge.remote :format " %k from %d %v," :face 'bold)
+ ("a" "pulling all topics"
+ (lambda (repo)
+ (interactive (list (forge--scope 'repo)))
+ (forge-add-repository repo)))
+ ("s" "pulling only topics since <date>"
+ (lambda (repo date)
+ (interactive
+ (list (forge--scope 'repo)
+ (forge-read-date "Limit pulling to topics updated since: ")))
+ (forge-add-repository repo date)))
+ ("i" "to allow pulling of individual topics"
+ (lambda (repo)
+ (interactive (list (forge--scope 'repo)))
+ (forge-add-repository repo :selective)))]
+
+ ;; Pivot.
+ [("o" "Add another repository" forge-add-some-repository)
+ (7 "U" "Add all source repositories belonging to a user"
+ forge-add-user-repositories)
+ (7 "O" "Add all source repositories belonging to an organization"
+ forge-add-organization-repositories)]]
+ (declare (interactive-only nil))
+ (interactive)
+ (cond
+ ((not repo)
+ (transient-setup 'forge-add-repository nil nil
+ :scope (forge-add-repository--scope)))
+ ((stringp repo)
+ (transient-setup 'forge-add-repository nil nil
+ :scope (forge-add-repository--scope repo)))
+ (t
+ (when-let*
+ (((not (eq limit :selective)))
+ ((magit-git-config-p "forge.autoPull" t))
+ (remote (oref repo remote))
+ (refspec (oref repo pullreq-refspec))
+ (default-directory (forge-get-worktree repo))
+ ((and (not (member refspec (magit-get-all "remote" remote "fetch")))
+ (or (eq forge-add-pullreq-refspec t)
+ (and (eq forge-add-pullreq-refspec 'ask)
+ (y-or-n-p (format "Also add %S refspec? " refspec)))))))
+ (magit-call-git "config" "--add"
+ (format "remote.%s.fetch" remote)
+ refspec))
+ (setq repo (forge-get-repository repo nil :insert!))
+ (when (eq limit :selective)
+ (oset repo selective-p t)
+ (setq limit nil))
+ (forge--pull repo
+ (and (not (forge-get-worktree repo)) #'ignore)
+ limit))))
+
+(defun forge-add-repository--scope (&optional directory)
+ (let* ((repo (if directory
+ (forge-get-repository directory nil :stub?)
+ (forge-get-repository :stub?)))
+ (wtree (and repo (forge-get-worktree repo)))
+ (condition (and repo (oref repo condition)))
+ (val
+ `((repo . ,repo)
+ (wtree . ,wtree)
+ (condition . ,condition)
+ (:tracked . ,(eq condition :tracked))
+ (:untracked . ,(memq condition '(:known :stub)))
+ (topdir . ,(or wtree (magit-toplevel)))
+ (url . ,(and repo (forge-get-url repo))))))
+ val))
+
+(defun forge--scope (&optional key)
+ ;; `transient-scope' itself probably offer optional KEY.
+ (let ((scope (transient-scope)))
+ (if key (alist-get key scope) scope)))
+
+(defun forge-add-some-repository (url)
+ "Read a repository and add it to the database."
+ (interactive
+ (let (ret url)
+ (while (not ret)
+ (setq url (magit-read-string-ns
+ "Add repository to database (url, owner/name, or name)" url))
+ (unless (string-match-p "\\(://\\|@\\)" url)
+ (setq url (magit-clone--name-to-url url)))
+ (cond ((forge-get-repository url nil :tracked?)
+ (message "%s is already being tracked locally"
+ (propertize url 'face 'bold))
+ (sit-for 3))
+ ((not (forge-get-repository url nil :valid?))
+ (message "%s does not exist or is inaccessible"
+ (propertize url 'face 'bold))
+ (sit-for 3))
+ ((setq ret url))))
+ (list ret)))
+ (forge-add-repository url))
+
+;;;###autoload
+(defun forge-add-user-repositories (host user)
+ "Add all of USER's repositories from HOST to the database.
+This may take a while. Only Github is supported at the moment."
+ (interactive
+ (list (forge-read-host "Add repositories from Github host"
+ 'forge-github-repository)
+ (read-string "User: ")))
+ (forge--add-user-repos 'forge-github-repository host user))
+
+;;;###autoload
+(defun forge-add-organization-repositories (host organization)
+ "Add all of ORGANIZATION's repositories from HOST to the database.
+This may take a while. Only Github is supported at the moment."
+ (interactive
+ (list (forge-read-host "Add repositories from Github host"
+ 'forge-github-repository)
+ (read-string "Organization: ")))
+ (forge--add-organization-repos 'forge-github-repository host organization))
+
+;;; Cleanup
+
+;;;###autoload
+(defun forge-remove-repository (repository)
+ "Remove a repository from the database."
+ (interactive
+ (pcase-let* ((repo (forge-read-repository "Remove repository from db"))
+ ((eieio githost owner name) repo))
+ (if (yes-or-no-p (format "Do you really want to remove \"%s/%s @%s\" %s? "
+ owner name githost "from the database"))
+ (list repo)
+ (user-error "Abort"))))
+ (closql-delete repository)
+ (forge-refresh-buffer))
+
+;;;###autoload
+(defun forge-remove-topic-locally (topic)
+ "Remove a topic from the local database only.
+Due to how the supported APIs work, it would be too expensive to
+automatically remove topics from the local database that were
+removed from the forge. The purpose of this command is to allow
+you to manually clean up the local database."
+ (interactive (list (forge-read-topic "Delete topic LOCALLY only")))
+ (setq topic (forge-get-topic topic))
+ (closql-delete topic)
+ (if (and (derived-mode-p 'forge-topic-mode)
+ (eq (oref topic id)
+ (oref forge-buffer-topic id)))
+ (kill-buffer (current-buffer))
+ (forge-refresh-buffer)))
+
+;;;###autoload
+(defun forge-reset-database ()
+ "Move the current database file to the trash.
+This is useful after the database scheme has changed, which will
+happen a few times while the forge functionality is still under
+heavy development."
+ (interactive)
+ (when (and (file-exists-p forge-database-file)
+ (yes-or-no-p "Really trash Forge's database file? "))
+ (when-let ((db (forge-db t)))
+ (emacsql-close db))
+ (delete-file forge-database-file t)
+ (forge-refresh-buffer)))
+
+;;; Miscellaneous
+
+(magit-define-section-jumper forge-jump-to-pullreqs "Pull requests" pullreqs)
+(magit-define-section-jumper forge-jump-to-issues "Issues" issues)
+
+;;; _
+(provide 'forge-commands)
+;;; forge-commands.el ends here
--- /dev/null
+;;; forge-core.el --- Core functionality -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'magit)
+
+(require 'cl-lib)
+(require 'compat)
+(require 'dash)
+(require 'eieio)
+(require 'seq)
+(require 'subr-x)
+
+(require 'transient)
+
+(require 'forge-db)
+
+(eval-when-compile
+ (cl-pushnew 'id eieio--known-slot-names)
+ (cl-pushnew 'name eieio--known-slot-names)
+ (cl-pushnew 'number eieio--known-slot-names)
+ (cl-pushnew 'owner eieio--known-slot-names)
+ (cl-pushnew 'worktree eieio--known-slot-names))
+
+;;; Options
+
+(defgroup forge nil
+ "Options concerning Git forges."
+ :group 'magit)
+
+(defgroup forge-faces nil
+ "Faces concerning Git forges."
+ :group 'forge
+ :group 'magit-faces)
+
+(defcustom forge-alist
+ '(;; Forges
+ ("github.com" "api.github.com"
+ "github.com" forge-github-repository)
+ ("gitlab.com" "gitlab.com/api/v4"
+ "gitlab.com" forge-gitlab-repository)
+ ("salsa.debian.org" "salsa.debian.org/api/v4"
+ "salsa.debian.org" forge-gitlab-repository)
+ ("framagit.org" "framagit.org/api/v4"
+ "framagit.org" forge-gitlab-repository)
+ ("gitlab.gnome.org" "gitlab.gnome.org/api/v4"
+ "gitlab.gnome.org" forge-gitlab-repository)
+ ;; Forges (API unsupported)
+ ("codeberg.org" "codeberg.org/api/v1"
+ "codeberg.org" forge-gitea-repository)
+ ("bitbucket.org" "api.bitbucket.org/2.0"
+ "bitbucket.org" forge-bitbucket-repository)
+ ;; Semi-Forges
+ ("git.savannah.gnu.org" nil
+ "git.savannah.gnu.org" forge-cgit**-repository)
+ ("git.kernel.org" nil
+ "git.kernel.org" forge-cgit-repository)
+ ("repo.or.cz" nil
+ "repo.or.cz" forge-repoorcz-repository)
+ ("git.suckless.org" nil
+ "git.suckless.org" forge-stagit-repository)
+ ("git.sr.ht" nil
+ "git.sr.ht" forge-srht-repository))
+ "List of Git forges.
+
+Each entry has the form (GITHOST APIHOST WEBHOST CLASS).
+
+- GITHOST is the host used to access repositories on the forge using
+ Git.
+
+- APIHOST is the host used to access the forge's API. For some forges
+ the isn't just a host, but a host followed by the path to the API's
+ endpoint.
+
+- WEBHOST is the host used to access repositories on this forge using
+ a browser. The IDs used to identify repositories from the forge in
+ the local database also derives from this value.
+
+- CLASS is the class to be used for repositories from the forge.
+
+Complications:
+
+- When connecting to a Github Enterprise edition whose REST API's
+ end point is \"<host>/v3\" and whose GraphQL API's end point is
+ \"<host>/graphql\", then use \"<host>/v3\" as APIHOST. This is a
+ historic accident. See issue #174.
+
+- WEBHOST and CLASS cannot be changed once you have added one or
+ more repositories from a forge. Changing GITHOST and/or APIHOST
+ may be possible, but should seldom be necessary."
+ :package-version '(forge . "0.1.0")
+ :group 'forge
+ :type '(repeat (list (string :tag "Git host")
+ (choice (string :tag "API endpoint")
+ (const :tag "No API" nil))
+ (string :tag "ID")
+ (symbol :tag "Repository class"))))
+
+;;; Class
+
+(defclass forge-object (closql-object) () :abstract t)
+
+(defmacro forge--childp (obj type)
+ "Somewhat similar to `cl-typep' but only for (possibly unknown) classes.
+TYPE is evaluated at macro-expansion time but, unlike with
+`cl-typep', the respective class does not have to be defined
+at that time."
+ (let ((fn (intern (concat (symbol-name (eval type)) "--eieio-childp"))))
+ `(and (fboundp ',fn) (,fn ,obj))))
+
+;;; Query
+
+(cl-defgeneric forge-get-parent (object)
+ "Return the parent object of OBJECT.
+The hierarchy is repository > topic > post.
+For other objects return nil.")
+
+(cl-defgeneric forge-get-repository (demand)
+ "Return a forge repository object or nil, or signal an error.
+
+A forge repository is a repository hosted on a forge. The local clone
+is also a \"repository\", but it is a \"Git\" repository, not a \"Forge\"
+repository. (Forge repositories are also Git repositories, but not the
+other way around.)
+
+A `:known' repository has an entry in the local database. All other
+repositories are unknown. `:known' repositories are divided into two
+subgroups: `:tracked' and \"untracked\" repositories.
+
+A `:tracked' repository was previously explicitly added to the database
+by the user.
+
+When Forge encounters a repository, without being instructed by the user
+to track it, it may nevertheless add limited information about it to the
+database. Such a repository is `:known' but it is not `:tracked'.
+
+Other repositories are \"unknown\". Most commands can only deal with
+repositories that are stored in the database. Of these, some can deal
+with any `:known' repositories, others require that they are `:tracked'.
+
+Some other commands exist — such as the browse commands — that have no
+such requirement. While such commands also require a repository object,
+they do not care whether that is stored in the database. Instead they
+are happy to use a `:stub' repository; a repository that is not stored
+in the database.
+
+The DEMAND argument specifies what kind of repository object the caller
+requires, at least. `:tracked' is greater than `:known', which is
+greater than `:stub'. For example, if the caller requests a `:known'
+repository, a `:tracked' repository will do, while a `:stub' repository
+will not.
+
+The valid values for DEMAND are:
+
+- `:tracked' and `:tracked?' request a repository that the user added
+ to the database. If there is no such repository, the former causes
+ an error to be signaled, while for the latter nil is returned.
+
+- `:known?' and `:insert!' request a repository from the database.
+ Whether the user explicitly added it does not matter. If there is no
+ such repository, nil is returned for the former, while for the latter
+ a new repository is inserted into the repository and then returned.
+
+- `:stub' and `:stub?' request the Forge repository corresponding to
+ the current Git repository. It does not matter whether it is known.
+ This fails if `default-directory' is not inside a Git repository, if
+ there is no matching entry in `forge-alist', or if it is unclear which
+ remote to use. If the repository cannot be determined, the former
+ causes an error to be signaled, while for the latter nil is returned.
+
+ Stub repository objects are created without making an API request, so
+ we lack access to the upstream ID, which the IDs used in out database,
+ derive from. Stub repositories are \"unknown\" in the sense that their
+ IDs are not `:known'. This is done to allow offline operations.
+
+- `:valid?' requests the Forge repository corresponding to the current
+ Git repository. It does not matter whether it is known. If it is
+ unknown, an API request is made to verify that the repository exists
+ on the forge. If it does, an object with a valid upstream ID is
+ returned, but that isn't inserted into the database. If not, nil is
+ returned.
+
+Given a repository object, you can query its `condition' slot to learn
+whether it is `:tracked', `:known' (i.e., has a valid ID and is stored
+in the database), or merely a `:stub'.
+
+You can also use (forge-get repository OBJECT nil DEMAND) to check the
+condition of a repository object, or even to ensure a repository object
+has a valid upstream ID (using `:valid?'), or that it is tracked in the
+database (using `:insert!').
+
+Use `forge-repository-equal' to check if two objects refer to the same
+repository.
+
+Also see info node `(forge) Repository Detection'.")
+
+(cl-defgeneric forge-get-topic ()
+ "Return a forge issue or pullreq object.")
+
+(cl-defgeneric forge-get-issue ()
+ "Return a forge issue object.")
+
+(cl-defgeneric forge-get-pullreq ()
+ "Return a forge pullreq object.")
+
+(defun forge--get-forge-host (host &optional demand)
+ "Return `forge-alist' entry matching HOST.
+
+Entries have the form (GITHOST APIHOST WEBHOST CLASS).
+
+- If HOST matches a GITHOST, return the corresponding entry.
+- Else, if HOST is an ssh alias and the canonical hostname matches a
+ GITHOST, return the corresponding entry.
+- Finally, if HOST matches a WEBHOST, return the corresponding entry.
+
+If no entry matches, return nil, or signal an error if optional DEMAND
+is non-nil."
+ (or (assoc host forge-alist)
+ (assoc (seq-some (lambda (line)
+ (and (string-prefix-p "hostname" line)
+ (substring line 9)))
+ (ignore-errors
+ (process-lines-ignore-status "ssh" "-G" host)))
+ forge-alist)
+ (car (cl-member host forge-alist :test #'equal :key #'caddr))
+ (and demand
+ (error "No entry for \"%s\" in `forge-alist'" host))))
+
+(defun forge--split-forge-url (url &optional relax)
+ (save-match-data
+ (cond
+ ((string-match
+ (concat "\\`"
+ "\\(?:git://\\|"
+ "[^/@]+@\\|"
+ "\\(?:ssh\\|ssh\\+git\\|git\\+ssh\\)://\\(?:[^/@]+@\\)?\\|"
+ "https?://\\(?:[^/@]+@\\)?\\)?"
+ (if relax
+ "\\(?1:[^:/]+\\)"
+ (regexp-opt (mapcar #'car forge-alist) t))
+ "\\(?::[0-9]+\\)?"
+ "\\(?:/\\|:/?\\)"
+ "~?\\(?2:.+?\\)/"
+ "\\(?3:[^/]+?\\)"
+ "\\(?:\\.git\\|/\\)?"
+ "\\'")
+ url)
+ (and-let* ((elt (forge--get-forge-host (match-string 1 url) (not relax))))
+ ;; Return the WEBHOST (not the GITHOST, URLs passed to this
+ ;; function usually contain a GITHOST) because the IDs used to
+ ;; identify a repository in the database are based on WEBHOSTs.
+ (list (caddr elt)
+ (match-string 2 url)
+ (match-string 3 url))))
+ ((not relax)
+ ;; The host part didn't match any GITHOST in `forge-alist', but it
+ ;; might be a ssh host alias. We have to relax strictness; in the
+ ;; extremely unlikely case that there is a common path between the
+ ;; HOST and the OWNER for this forge, we would incorrectly end up
+ ;; making that path part of the owner.
+ (forge--split-forge-url url t)))))
+
+;;; Identity
+
+(cl-defgeneric forge--object-id (class &rest args)
+ "Return the database id for the CLASS object specified by ARGS.")
+
+(cl-defgeneric forge--repository-ids ( class host owner name
+ &optional stub noerror)
+ "Return the database and forge ids for the specified CLASS object.")
+
+(cl-defmethod magit-section-ident-value ((obj forge-object))
+ "Return the value ob OBJ's `id' slot.
+Using OBJ itself would not be appropriate because multiple
+non-equal objects may exist, representing the same thing."
+ (oref obj id))
+
+(defun forge--set-id-slot (repo object slot rows)
+ "Set the value in OBJECT for SLOT to VALUE, actually storing foreign keys."
+ ;; TODO Should CloSQL advice `oset' to make this unnecessary?
+ (let ((repo-id (oref repo id)))
+ (closql-oset
+ object slot
+ (mapcar (lambda (val)
+ (forge--object-id repo-id
+ (if (atom val) val (alist-get 'id val))))
+ rows))))
+
+;;; Format
+
+(cl-defgeneric forge--format (object slot &optional spec)
+ "Return a string based on SPEC and the format-string in OBJECT's SLOT.
+The available `format'-like specs depend on the type of OBJECT.
+SPEC can be used to add additional specs, as for `format-spec'.
+The latter override the former. SLOT is expected to be class-
+allocated. Some methods also accept a format string in place
+of SLOT.")
+
+(cl-defmethod forge--format-resource ((object forge-object) resource)
+ "Return an API resource based on RESOURCE and slots of OBJECT.
+For use in `forge--FORGE-METHOD' such as `forge--ghub-get'.
+RESOURCE is a string separated by slashes. Each part that begins
+with a colon is replaced with a value from OBJECT. `:repo' is a
+synonym for `:name'. `:project' is a like `:owner/:name', but the
+slash is quoted on Gitlab. `:topic' is a synonym for `:number'
+but only if OBJECT is a topic. Any other `:SLOT' means to use
+the value of that slot in OBJECT, or if that doesn't exist in its
+parent object (determined using `forge-get-parent')."
+ (save-match-data
+ (setq resource
+ (replace-regexp-in-string
+ ":\\([^/]+\\)"
+ (lambda (str)
+ (let ((slot (intern (substring str 1))))
+ (or (and-let*
+ ((v (ignore-errors
+ (pcase slot
+ ('repo (oref object name))
+ ('project (concat (string-replace
+ "/" "%2F" (oref object owner))
+ "%2F"
+ (oref object name)))
+ ('topic (and (forge--childp object 'forge-topic)
+ (oref object number)))
+ (_ (eieio-oref object slot))))))
+ (format "%s" v))
+ str)))
+ resource t t))
+ (if (string-match ":[^/]*" resource)
+ (if-let ((parent (ignore-errors (forge-get-parent object))))
+ (forge--format-resource parent resource)
+ (error "Cannot resolve %s for a %s"
+ (match-string 0 resource)
+ (eieio-object-class object)))
+ resource)))
+
+;;; Miscellaneous
+
+(defun forge-refresh-buffer (&optional buffer)
+ "Refresh the current buffer, if it is a Magit or Forge buffer.
+Refresh the buffer if its major-mode derives from `magit-mode'
+or `forge-repository-list-mode'. If optional BUFFER is non-nil,
+then refresh that buffer, provided it is alive and satisfies
+the mode requirement."
+ (interactive)
+ (cond (buffer
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (forge-refresh-buffer))))
+ ((derived-mode-p 'forge-topic-mode)
+ (magit-refresh-buffer))
+ ((derived-mode-p 'magit-mode)
+ (magit-refresh-buffer))
+ ((and (derived-mode-p 'forge-topic-mode)
+ (boundp 'forge--buffer-topics-spec)
+ (oref forge--buffer-topics-spec global))
+ (revert-buffer))
+ ((derived-mode-p 'forge-repository-list-mode)
+ (revert-buffer))))
+
+(defun forge--sanitize-string (string)
+ ;; For Gitlab this may also be nil.
+ (if string (string-replace "\r\n" "\n" string) ""))
+
+(defun forge--uuid ()
+ "Return string with random (version 4) UUID."
+ ;; This is a copy of `org-id-uuid'.
+ ;; Only used in `forge-create-mark'.
+ (let ((rnd (md5 (format "%s%s%s%s%s%s%s"
+ (random)
+ (current-time)
+ (user-uid)
+ (emacs-pid)
+ (user-full-name)
+ user-mail-address
+ (recent-keys)))))
+ (format "%s-%s-4%s-%s%s-%s"
+ (substring rnd 0 8)
+ (substring rnd 8 12)
+ (substring rnd 13 16)
+ (format "%x"
+ (logior
+ #b10000000
+ (logand
+ #b10111111
+ (string-to-number
+ (substring rnd 16 18) 16))))
+ (substring rnd 18 20)
+ (substring rnd 20 32))))
+
+;;; _
+(provide 'forge-core)
+;;; forge-core.el ends here
--- /dev/null
+;;; forge-db.el --- Database implementation -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'closql)
+(require 'compat)
+(require 'eieio)
+(require 'emacsql)
+
+;; For `closql--db-update-schema':
+(declare-function forge--object-id "forge-core")
+(declare-function forge-get-issue "forge-core")
+(declare-function forge-get-pullreq "forge-core")
+(declare-function forge-get-repository "forge-core" (demand))
+
+(eval-when-compile
+ (cl-pushnew 'number eieio--known-slot-names)
+ (cl-pushnew 'value eieio--known-slot-names))
+
+;;; Options
+
+(defcustom forge-database-file
+ (expand-file-name "forge-database.sqlite" user-emacs-directory)
+ "The file used to store the forge database."
+ :package-version '(forge . "0.1.0")
+ :group 'forge
+ :type 'file)
+
+;;; Core
+
+(defclass forge-database (closql-database)
+ ((name :initform "Forge")
+ (object-class :initform 'forge-repository)
+ (file :initform 'forge-database-file)
+ (schemata :initform 'forge--db-table-schemata)
+ (version :initform 13)))
+
+(defvar forge--override-connection-class nil)
+
+(defun forge-db (&optional livep)
+ (closql-db 'forge-database livep forge--override-connection-class))
+
+(defun forge-sql (sql &rest args)
+ (if (stringp sql)
+ (emacsql (forge-db) (apply #'format sql args))
+ (apply #'emacsql (forge-db) sql args)))
+
+(defun forge-sql-cdr (sql &rest args)
+ (mapcar #'cdr (apply #'forge-sql sql args)))
+
+(defun forge-connect-database-once ()
+ "Try to connect Forge database on first use of `magit-status' only."
+ (remove-hook 'magit-status-mode-hook #'forge-connect-database-once)
+ (forge-db))
+(add-hook 'magit-status-mode-hook #'forge-connect-database-once)
+
+(defun forge-enable-sql-logging ()
+ "Enable logging Forge's SQL queries."
+ (interactive)
+ (let ((conn (oref (forge-db) connection)))
+ (emacsql-enable-debugging conn)
+ (switch-to-buffer-other-window (oref conn log-buffer))))
+
+;;; Schemata
+
+(defconst forge--db-table-schemata
+ '((repository
+ [(class :not-null)
+ (id :not-null :primary-key)
+ forge-id
+ forge
+ owner
+ name
+ apihost
+ githost
+ remote
+ condition
+ created
+ updated
+ pushed
+ parent
+ description
+ homepage
+ default-branch
+ archived-p
+ fork-p
+ locked-p
+ mirror-p
+ private-p
+ issues-p
+ wiki-p
+ stars
+ watchers
+ (assignees :default eieio-unbound)
+ (forks :default eieio-unbound)
+ (issues :default eieio-unbound)
+ (labels :default eieio-unbound)
+ (revnotes :default eieio-unbound)
+ (pullreqs :default eieio-unbound)
+ selective-p
+ worktree
+ (milestones :default eieio-unbound)
+ issues-until
+ pullreqs-until
+ ])
+
+ (assignee
+ [(repository :not-null)
+ (id :not-null :primary-key)
+ login
+ name
+ forge-id] ; Needed for Gitlab.
+ (:foreign-key
+ [repository] :references repository [id]
+ :on-delete :cascade))
+
+ (fork
+ [(parent :not-null)
+ (id :not-null :primary-key)
+ owner
+ name]
+ (:foreign-key
+ [parent] :references repository [id]
+ :on-delete :cascade))
+
+ (issue
+ [(class :not-null)
+ (id :not-null :primary-key)
+ repository
+ number
+ state
+ author
+ title
+ created
+ updated
+ closed
+ status
+ locked-p
+ milestone
+ body
+ (assignees :default eieio-unbound)
+ (cards :default eieio-unbound)
+ (edits :default eieio-unbound)
+ (labels :default eieio-unbound)
+ (participants :default eieio-unbound)
+ (posts :default eieio-unbound)
+ (reactions :default eieio-unbound)
+ (timeline :default eieio-unbound)
+ (marks :default eieio-unbound)
+ note
+ their-id
+ slug
+ saved-p]
+ (:foreign-key
+ [repository] :references repository [id]
+ :on-delete :cascade))
+
+ (issue-assignee
+ [(issue :not-null)
+ (id :not-null)]
+ (:foreign-key
+ [issue] :references issue [id]
+ :on-delete :cascade))
+
+ (issue-label
+ [(issue :not-null)
+ (id :not-null)]
+ (:foreign-key
+ [issue] :references issue [id]
+ :on-delete :cascade)
+ (:foreign-key
+ [id] :references label [id]
+ :on-delete :cascade))
+
+ (issue-mark
+ [(issue :not-null)
+ (id :not-null)]
+ (:foreign-key
+ [issue] :references issue [id]
+ :on-delete :cascade)
+ (:foreign-key
+ [id] :references mark [id]
+ :on-delete :cascade))
+
+ (issue-post
+ [(class :not-null)
+ (id :not-null :primary-key)
+ issue
+ number
+ author
+ created
+ updated
+ body
+ (edits :default eieio-unbound)
+ (reactions :default eieio-unbound)]
+ (:foreign-key
+ [issue] :references issue [id]
+ :on-delete :cascade))
+
+ (label
+ [(repository :not-null)
+ (id :not-null :primary-key)
+ name
+ color
+ description]
+ (:foreign-key
+ [repository] :references repository [id]
+ :on-delete :cascade))
+
+ (mark
+ [;; For now this is always nil because it seems more useful to
+ ;; share marks between repositories. We cannot omit this slot
+ ;; though because `closql--iref' expects `id' to be the second
+ ;; slot.
+ repository
+ (id :not-null :primary-key)
+ name
+ face
+ description])
+
+ (milestone
+ [(repository :not-null)
+ (id :not-null :primary-key)
+ number
+ title
+ created
+ updated
+ due
+ closed
+ description]
+ (:foreign-key
+ [repository] :references repository [id]
+ :on-delete :cascade))
+
+ (notification
+ [(class :not-null)
+ (id :not-null :primary-key)
+ thread-id
+ repository
+ type
+ topic
+ url
+ title
+ reason
+ last-read
+ updated]
+ (:foreign-key
+ [repository] :references repository [id]
+ :on-delete :cascade))
+
+ (pullreq
+ [(class :not-null)
+ (id :not-null :primary-key)
+ repository
+ number
+ state
+ author
+ title
+ created
+ updated
+ closed
+ merged
+ status
+ locked-p
+ editable-p
+ cross-repo-p
+ base-ref
+ base-repo
+ head-ref
+ head-user
+ head-repo
+ milestone
+ body
+ (assignees :default eieio-unbound)
+ (cards :default eieio-unbound)
+ (commits :default eieio-unbound)
+ (edits :default eieio-unbound)
+ (labels :default eieio-unbound)
+ (participants :default eieio-unbound)
+ (posts :default eieio-unbound)
+ (reactions :default eieio-unbound)
+ (review-requests :default eieio-unbound)
+ (reviews :default eieio-unbound)
+ (timeline :default eieio-unbound)
+ (marks :default eieio-unbound)
+ note
+ base-rev
+ head-rev
+ draft-p
+ their-id
+ slug
+ saved-p]
+ (:foreign-key
+ [repository] :references repository [id]
+ :on-delete :cascade))
+
+ (pullreq-assignee
+ [(pullreq :not-null)
+ (id :not-null)]
+ (:foreign-key
+ [pullreq] :references pullreq [id]
+ :on-delete :cascade))
+
+ (pullreq-label
+ [(pullreq :not-null)
+ (id :not-null)]
+ (:foreign-key
+ [pullreq] :references pullreq [id]
+ :on-delete :cascade)
+ (:foreign-key
+ [id] :references label [id]
+ :on-delete :cascade))
+
+ (pullreq-mark
+ [(pullreq :not-null)
+ (id :not-null)]
+ (:foreign-key
+ [pullreq] :references pullreq [id]
+ :on-delete :cascade)
+ (:foreign-key
+ [id] :references mark [id]
+ :on-delete :cascade))
+
+ (pullreq-post
+ [(class :not-null)
+ (id :not-null :primary-key)
+ pullreq
+ number
+ author
+ created
+ updated
+ body
+ (edits :default eieio-unbound)
+ (reactions :default eieio-unbound)]
+ (:foreign-key
+ [pullreq] :references pullreq [id]
+ :on-delete :cascade))
+
+ (pullreq-review-request
+ [(pullreq :not-null)
+ (id :not-null)]
+ (:foreign-key
+ [pullreq] :references pullreq [id]
+ :on-delete :cascade))
+
+ (revnote
+ [(class :not-null)
+ (id :not-null :primary-key)
+ repository
+ commit
+ file
+ line
+ author
+ body]
+ (:foreign-key
+ [repository] :references repository [id]
+ :on-delete :cascade))))
+
+(cl-defmethod closql--db-update-schema ((db forge-database))
+ (let ((code-version (oref-default 'forge-database version))
+ (version (closql--db-get-version db)))
+ (when (< version code-version)
+ (forge--backup-database db))
+ (closql-with-transaction db
+ (when (= version 2)
+ (message "Upgrading Forge database from version 2 to 3...")
+ (emacsql db [:create-table pullreq-review-request $S1]
+ (cdr (assq 'pullreq-review-request forge--db-table-schemata)))
+ (closql--db-set-version db (setq version 3))
+ (message "Upgrading Forge database from version 2 to 3...done"))
+ (when (= version 3)
+ (message "Upgrading Forge database from version 3 to 4...")
+ (emacsql db [:drop-table notification])
+ (pcase-dolist (`(,table . ,schema) forge--db-table-schemata)
+ (when (memq table '(notification
+ mark issue-mark pullreq-mark))
+ (emacsql db [:create-table $i1 $S2] table schema)))
+ (emacsql db [:alter-table issue :add-column marks :default $s1] 'eieio-unbound)
+ (emacsql db [:alter-table pullreq :add-column marks :default $s1] 'eieio-unbound)
+ (closql--db-set-version db (setq version 4))
+ (message "Upgrading Forge database from version 3 to 4...done"))
+ (when (= version 4)
+ (message "Upgrading Forge database from version 4 to 5...")
+ (emacsql db [:alter-table repository :add-column selective-p :default nil])
+ (closql--db-set-version db (setq version 5))
+ (message "Upgrading Forge database from version 4 to 5...done"))
+ (when (= version 5)
+ (message "Upgrading Forge database from version 5 to 6...")
+ (emacsql db [:alter-table repository :add-column worktree :default nil])
+ (closql--db-set-version db (setq version 6))
+ (message "Upgrading Forge database from version 5 to 6...done"))
+ (when (= version 6)
+ (message "Upgrading Forge database from version 6 to 7...")
+ (emacsql db [:alter-table issue :add-column note :default nil])
+ (emacsql db [:alter-table pullreq :add-column note :default nil])
+ (emacsql db [:create-table milestone $S1]
+ (cdr (assq 'milestone forge--db-table-schemata)))
+ (emacsql db [:alter-table repository :add-column milestones :default $s1]
+ 'eieio-unbound)
+ (pcase-dolist (`(,repo-id ,issue-id ,milestone)
+ (emacsql db [:select [repository id milestone]
+ :from issue
+ :where (notnull milestone)]))
+ (unless (stringp milestone)
+ (oset (forge-get-issue issue-id) milestone
+ (forge--object-id repo-id (cdar milestone)))))
+ (pcase-dolist (`(,repo-id ,pullreq-id ,milestone)
+ (emacsql db [:select [repository id milestone]
+ :from pullreq
+ :where (notnull milestone)]))
+ (unless (stringp milestone)
+ (oset (forge-get-pullreq pullreq-id) milestone
+ (forge--object-id repo-id (cdar milestone)))))
+ (closql--db-set-version db (setq version 7))
+ (message "Upgrading Forge database from version 6 to 7...done"))
+ (when (= version 7)
+ (message "Upgrading Forge database from version 7 to 8...")
+ (emacsql db [:alter-table pullreq :add-column base-rev :default nil])
+ (emacsql db [:alter-table pullreq :add-column head-rev :default nil])
+ (emacsql db [:alter-table pullreq :add-column draft-p :default nil])
+ (closql--db-set-version db (setq version 8))
+ (message "Upgrading Forge database from version 7 to 8...done"))
+ (when (= version 8)
+ (message "Upgrading Forge database from version 8 to 9...")
+ (emacsql db [:alter-table pullreq :add-column their-id :default nil])
+ (emacsql db [:alter-table issue :add-column their-id :default nil])
+ (closql--db-set-version db (setq version 9))
+ (message "Upgrading Forge database from version 8 to 9...done"))
+ (when (= version 9)
+ (message "Upgrading Forge database from version 9 to 10...")
+ (emacsql db [:alter-table pullreq :add-column slug :default nil])
+ (emacsql db [:alter-table issue :add-column slug :default nil])
+ (pcase-dolist (`(,id ,number ,type)
+ (emacsql
+ db
+ [:select [pullreq:id pullreq:number repository:class]
+ :from pullreq
+ :join repository
+ :on (= pullreq:repository repository:id)]))
+ (let ((gitlabp (memq type
+ (append (closql-where-class-in
+ 'forge-gitlab-repository--eieio-childp)
+ nil))))
+ (emacsql db [:update pullreq :set (= slug $s1) :where (= id $s2)]
+ (format "%s%s" (if gitlabp "!" "#") number)
+ id)))
+ (pcase-dolist (`(,id ,number)
+ (emacsql db [:select [id number] :from issue]))
+ (emacsql db [:update issue :set (= slug $s1) :where (= id $s2)]
+ (format "#%s" number)
+ id))
+ (closql--db-set-version db (setq version 10))
+ (message "Upgrading Forge database from version 9 to 10...done"))
+ (when (= version 10)
+ (message "Upgrading Forge database from version 10 to 11...")
+ (emacsql db [:drop-table notification])
+ (emacsql db [:create-table notification $S1]
+ (cdr (assq 'notification forge--db-table-schemata)))
+ (emacsql db [:alter-table pullreq :rename-column unread-p :to status])
+ (emacsql db [:alter-table issue :rename-column unread-p :to status])
+ (emacsql db [:alter-table pullreq :add-column saved-p :default nil])
+ (emacsql db [:alter-table issue :add-column saved-p :default nil])
+ (closql--db-set-version db (setq version 11))
+ (message "Upgrading Forge database from version 10 to 11...done"))
+ (when (= version 11)
+ (message "Upgrading Forge database from version 11 to 12...")
+ (emacsql db [:drop-table notification])
+ (emacsql db [:create-table notification $S1]
+ (cdr (assq 'notification forge--db-table-schemata)))
+ (dolist (id (emacsql db [:select id :from issue :where (= state 'closed)]))
+ (emacsql db [:update issue :set (= state 'completed) :where (= id $s1)]
+ id))
+ (dolist (id (emacsql db [:select id :from issue :where (isnull status)]))
+ (emacsql db [:update issue :set (= state 'done) :where (= id $s1)]
+ id))
+ (dolist (id (emacsql db [:select id :from pullreq :where (= state 'closed)]))
+ (emacsql db [:update pullreq :set (= state 'rejected) :where (= id $s1)]
+ id))
+ (dolist (id (emacsql db [:select id :from pullreq :where (isnull status)]))
+ (emacsql db [:update pullreq :set (= state 'done) :where (= id $s1)]
+ id))
+ (emacsql db [:alter-table repository :add-column issues-until :default nil])
+ (emacsql db [:alter-table repository :add-column pullreqs-until :default nil])
+ (closql--db-set-version db (setq version 12))
+ (message "Upgrading Forge database from version 11 to 12...done"))
+ (when (= version 12)
+ (message "Upgrading Forge database from version 12 to 13...")
+ (dolist (id (emacsql db [:select id :from repository
+ :where (isnull issues-until)]))
+ (emacsql
+ db [:update repository :set (= issues-until $s1) :where (= id $s2)]
+ (caar (forge-sql [:select [updated] :from issue
+ :where (= repository $s1)
+ :order-by [(desc updated)]
+ :limit 1]
+ id))
+ id))
+ (dolist (id (emacsql db [:select id :from repository
+ :where (isnull pullreqs-until)]))
+ (emacsql
+ db [:update repository :set (= pullreqs-until $s1) :where (= id $s2)]
+ (caar (forge-sql [:select [updated] :from pullreq
+ :where (= repository $s1)
+ :order-by [(desc updated)]
+ :limit 1]
+ id))
+ id))
+ (emacsql db [:alter-table repository :rename-column sparse-p :to condition])
+ (pcase-dolist (`(,id ,not-tracked)
+ (emacsql db [:select [id condition] :from repository]))
+ (emacsql
+ db [:update repository :set (= condition $s1) :where (= id $s2)]
+ (if not-tracked :known :tracked)
+ id))
+ (closql--db-set-version db (setq version 13))
+ (message "Upgrading Forge database from version 12 to 13...done"))
+ )
+ (cl-call-next-method)))
+
+(defun forge--backup-database (db)
+ (let ((dst (concat (file-name-sans-extension forge-database-file)
+ (format "-v%s" (caar (emacsql (oref db connection)
+ [:pragma user-version])))
+ (format-time-string "-%Y%m%d-%H%M")
+ ".sqlite")))
+ (message "Copying Forge database to %s..." dst)
+ (copy-file forge-database-file dst)
+ (message "Copying Forge database to %s...done" dst)))
+
+;;; _
+(provide 'forge-db)
+;;; forge-db.el ends here
--- /dev/null
+;;; forge-gitea.el --- Gitea support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'gtea)
+(require 'forge)
+
+;;; Class
+
+(defclass forge-gitea-repository (forge-unusedapi-repository)
+ ((issues-url-format :initform "https://%h/%o/%n/issues")
+ (issue-url-format :initform "https://%h/%o/%n/issues/%i")
+ ;; The anchor for the issue itself is .../%i#issue-%i
+ (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#issuecomment-%I")
+ (pullreqs-url-format :initform "https://%h/%o/%n/pulls")
+ (pullreq-url-format :initform "https://%h/%o/%n/pulls/%i")
+ (pullreq-post-url-format :initform "https://%h/%o/%n/pulls/%i#issuecomment-%I")
+ (commit-url-format :initform "https://%h/%o/%n/commit/%r")
+ (branch-url-format :initform "https://%h/%o/%n/commits/branch/%r")
+ (remote-url-format :initform "https://%h/%o/%n")
+ (create-issue-url-format :initform "https://%h/%o/%n/issues/new")
+ (create-pullreq-url-format :initform "https://%h/%o/%n/pulls") ; sic
+ (pullreq-refspec :initform "+refs/pull/*/head:refs/pullreqs/*")))
+
+;;; _
+(provide 'forge-gitea)
+;;; forge-gitea.el ends here
--- /dev/null
+;;; forge-github.el --- Github support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ghub)
+
+(require 'forge)
+(require 'forge-issue)
+(require 'forge-pullreq)
+
+;;; Class
+
+(defclass forge-github-repository (forge-repository)
+ ((issues-url-format :initform "https://%h/%o/%n/issues")
+ (issue-url-format :initform "https://%h/%o/%n/issues/%i")
+ (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#issuecomment-%I")
+ (pullreqs-url-format :initform "https://%h/%o/%n/pulls")
+ (pullreq-url-format :initform "https://%h/%o/%n/pull/%i")
+ (pullreq-post-url-format :initform "https://%h/%o/%n/pull/%i#issuecomment-%I")
+ (commit-url-format :initform "https://%h/%o/%n/commit/%r")
+ (branch-url-format :initform "https://%h/%o/%n/commits/%r")
+ (remote-url-format :initform "https://%h/%o/%n")
+ (create-issue-url-format :initform "https://%h/%o/%n/issues/new")
+ (create-pullreq-url-format :initform "https://%h/%o/%n/compare")
+ (pullreq-refspec :initform "+refs/pull/*/head:refs/pullreqs/*")))
+
+;;; Query
+
+(defun forge--get-github-repository ()
+ (forge-github-repository-p (forge-get-repository :stub?)))
+
+;;; Pull
+;;;; Repository
+
+(cl-defmethod forge--pull ((repo forge-github-repository)
+ &optional callback since)
+ (cl-assert (not (and since (forge-get-repository repo nil :tracked?))))
+ (setq forge--mode-line-buffer (current-buffer))
+ (forge--msg repo t nil "Pulling REPO")
+ (let ((buf (current-buffer)))
+ (ghub-fetch-repository
+ (oref repo owner)
+ (oref repo name)
+ (lambda (data)
+ (forge--msg repo t t "Pulling REPO")
+ (forge--msg repo t nil "Storing REPO")
+ (closql-with-transaction (forge-db)
+ (let-alist data
+ (forge--update-repository repo data)
+ (forge--update-assignees repo .assignableUsers)
+ (forge--update-forks repo .forks)
+ (forge--update-labels repo .labels)
+ (forge--update-milestones repo .milestones)
+ (forge--update-issues repo .issues t)
+ (forge--update-pullreqs repo .pullRequests t)
+ (forge--update-revnotes repo .commitComments))
+ (oset repo condition :tracked))
+ (forge--msg repo t t "Storing REPO")
+ (cond
+ ((oref repo selective-p))
+ (callback (funcall callback))
+ ((forge--maybe-git-fetch repo buf))))
+ `((issues-until . ,(or since (oref repo issues-until)))
+ (pullRequests-until . ,(or since (oref repo pullreqs-until))))
+ :host (oref repo apihost)
+ :auth 'forge
+ :sparse (oref repo selective-p))))
+
+(cl-defmethod forge--update-repository ((repo forge-github-repository) data)
+ (let-alist data
+ (oset repo created .createdAt)
+ (oset repo updated .updatedAt)
+ (oset repo pushed .pushedAt)
+ (oset repo parent .parent.nameWithOwner)
+ (oset repo description .description)
+ (oset repo homepage (and (not (equal .homepageUrl "")) .homepageUrl))
+ (oset repo default-branch .defaultBranchRef.name)
+ (oset repo archived-p .isArchived)
+ (oset repo fork-p .isFork)
+ (oset repo locked-p .isLocked)
+ (oset repo mirror-p .isMirror)
+ (oset repo private-p .isPrivate)
+ (oset repo issues-p .hasIssuesEnabled)
+ (oset repo wiki-p .hasWikiEnabled)
+ (oset repo stars .stargazers.totalCount)
+ (oset repo watchers .watchers.totalCount)))
+
+(cl-defmethod forge--update-revnotes ((repo forge-github-repository) data)
+ (closql-with-transaction (forge-db)
+ (mapc (apply-partially #'forge--update-revnote repo) data)))
+
+(cl-defmethod forge--update-revnote ((repo forge-github-repository) data)
+ (closql-with-transaction (forge-db)
+ (let-alist data
+ (closql-insert
+ (forge-db)
+ (forge-revnote
+ :id (forge--object-id 'forge-revnote repo .id)
+ :repository (oref repo id)
+ :commit .commit.oid
+ :file .path
+ :line .position
+ :author .author.login
+ :body .body)
+ t))))
+
+(cl-defmethod forge--update-assignees ((repo forge-github-repository) data)
+ (oset repo assignees
+ (with-slots (id) repo
+ (mapcar (lambda (row)
+ (let-alist row
+ (list (forge--object-id id .id)
+ .login
+ .name
+ .id)))
+ (delete-dups data)))))
+
+(cl-defmethod forge--update-forks ((repo forge-github-repository) data)
+ (oset repo forks
+ (with-slots (id) repo
+ (mapcar (lambda (row)
+ (let-alist row
+ (nconc (forge--repository-ids
+ (eieio-object-class repo)
+ (oref repo githost)
+ .owner.login
+ .name)
+ (list .owner.login
+ .name))))
+ (delete-dups data)))))
+
+(cl-defmethod forge--update-labels ((repo forge-github-repository) data)
+ (oset repo labels
+ (with-slots (id) repo
+ (mapcar (lambda (row)
+ (let-alist row
+ (list (forge--object-id id .id)
+ .name
+ (concat "#" (downcase .color))
+ .description)))
+ (delete-dups data)))))
+
+(cl-defmethod forge--update-milestones ((repo forge-github-repository) data)
+ (oset repo milestones
+ (with-slots (id) repo
+ (mapcar (lambda (row)
+ (let-alist row
+ (list (forge--object-id id .id)
+ .number
+ .title
+ .createdAt
+ .updatedAt
+ .dueOn
+ .closedAt
+ .description)))
+ (delete-dups data)))))
+
+;;;; Topics
+
+(cl-defmethod forge--pull-topic ((repo forge-github-repository)
+ (number number))
+ (let ((id (oref repo id)))
+ (forge--pull-topic
+ repo
+ (forge-issue :repository id :number number)
+ :errorback (lambda (err _headers _status _req)
+ (when (equal (cdr (assq 'type (cadr err))) "NOT_FOUND")
+ (forge--pull-topic
+ repo
+ (forge-pullreq :repository id :number number)))))))
+
+(cl-defmethod forge--pull-topic ((repo forge-github-repository)
+ (topic forge-issue)
+ &key callback errorback)
+ (let ((buffer (current-buffer)))
+ (ghub-fetch-issue
+ (oref repo owner)
+ (oref repo name)
+ (oref topic number)
+ (lambda (data)
+ (forge--update-issue repo data)
+ (forge-refresh-buffer buffer)
+ (when callback (funcall callback)))
+ nil
+ :host (oref repo apihost)
+ :auth 'forge
+ :errorback errorback)))
+
+(cl-defmethod forge--pull-topic ((repo forge-github-repository)
+ (topic forge-pullreq)
+ &key callback errorback)
+ (let ((buffer (current-buffer)))
+ (ghub-fetch-pullreq
+ (oref repo owner)
+ (oref repo name)
+ (oref topic number)
+ (lambda (data)
+ (forge--update-pullreq repo data)
+ (forge-refresh-buffer buffer)
+ (when callback (funcall callback)))
+ nil
+ :host (oref repo apihost)
+ :auth 'forge
+ :errorback errorback)))
+
+(cl-defmethod forge--update-status ((repo forge-github-repository)
+ topic data bump initial-pull)
+ (let-alist data
+ (let ((updated (or .updatedAt .createdAt))
+ (current-status (oref topic status)))
+ (cond ((not .isReadByViewer)
+ (oset topic status 'unread))
+ (initial-pull
+ (oset topic status 'done))
+ ((null current-status)
+ (oset topic status 'pending))
+ ((string> updated (oref topic updated))
+ (oset topic status 'pending)))
+ (oset topic updated updated)
+ (when bump
+ (let* ((slot (if (forge-issue-p topic) 'issues-until 'pullreqs-until))
+ (until (eieio-oref repo slot)))
+ (when (or (not until) (string> updated until))
+ (eieio-oset repo slot updated)))))))
+
+;;;; Issues
+
+(cl-defmethod forge--update-issues ((repo forge-github-repository) data
+ &optional bump)
+ (closql-with-transaction (forge-db)
+ (let ((initial-pull (not (oref repo issues-until))))
+ (mapc (lambda (e) (forge--update-issue repo e bump initial-pull)) data))))
+
+(cl-defmethod forge--update-issue ((repo forge-github-repository) data
+ &optional bump initial-pull)
+ (let (issue-id issue)
+ (let-alist data
+ (closql-with-transaction (forge-db)
+ (setq issue-id (forge--object-id 'forge-issue repo .number))
+ (setq issue (or (forge-get-issue repo .number)
+ (closql-insert
+ (forge-db)
+ (forge-issue :id issue-id
+ :repository (oref repo id)
+ :number .number))))
+ (oset issue their-id .id)
+ (oset issue slug (format "#%s" .number))
+ (oset issue state
+ (pcase-exhaustive (list .stateReason .state)
+ (`("COMPLETED" ,_) 'completed)
+ (`("NOT_PLANNED" ,_) 'unplanned)
+ (`(,_ "CLOSED") 'completed)
+ (`(,_ "OPEN") 'open)))
+ (oset issue author .author.login)
+ (oset issue title .title)
+ (oset issue created .createdAt)
+ (oset issue closed .closedAt)
+ (oset issue locked-p .locked)
+ (oset issue milestone (and .milestone.id
+ (forge--object-id (oref repo id)
+ .milestone.id)))
+ (oset issue body (forge--sanitize-string .body))
+ (dolist (c .comments)
+ (let-alist c
+ (closql-insert
+ (forge-db)
+ (forge-issue-post
+ :id (forge--object-id issue-id .databaseId)
+ :issue issue-id
+ :number .databaseId
+ :author .author.login
+ :created .createdAt
+ :updated .updatedAt
+ :body (forge--sanitize-string .body))
+ t)))
+ (forge--update-status repo issue data bump initial-pull))
+ (ignore-errors
+ (forge--set-id-slot repo issue 'assignees .assignees))
+ (ignore-errors
+ (unless (magit-get-boolean "forge.kludge-for-issue-294")
+ (forge--set-id-slot repo issue 'labels .labels))))
+ issue))
+
+;;;; Pullreqs
+
+(cl-defmethod forge--update-pullreqs ((repo forge-github-repository) data
+ &optional bump)
+ (closql-with-transaction (forge-db)
+ (let ((initial-pull (not (oref repo pullreqs-until))))
+ (mapc (lambda (e) (forge--update-pullreq repo e bump initial-pull)) data))))
+
+(cl-defmethod forge--update-pullreq ((repo forge-github-repository) data
+ &optional bump initial-pull)
+ (let (pullreq-id pullreq)
+ (let-alist data
+ (closql-with-transaction (forge-db)
+ (setq pullreq-id (forge--object-id 'forge-pullreq repo .number))
+ (setq pullreq (or (forge-get-pullreq repo .number)
+ (closql-insert
+ (forge-db)
+ (forge-pullreq :id pullreq-id
+ :repository (oref repo id)
+ :number .number))))
+ (oset pullreq their-id .id)
+ (oset pullreq slug (format "#%s" .number))
+ (oset pullreq state (pcase-exhaustive .state
+ ("MERGED" 'merged)
+ ("CLOSED" 'rejected)
+ ("OPEN" 'open)))
+ (oset pullreq author .author.login)
+ (oset pullreq title .title)
+ (oset pullreq created .createdAt)
+ (oset pullreq closed .closedAt)
+ (oset pullreq merged .mergedAt)
+ (oset pullreq draft-p .isDraft)
+ (oset pullreq locked-p .locked)
+ (oset pullreq editable-p .maintainerCanModify)
+ (oset pullreq cross-repo-p .isCrossRepository)
+ (oset pullreq base-ref .baseRef.name)
+ (oset pullreq base-rev .baseRefOid)
+ (oset pullreq base-repo .baseRef.repository.nameWithOwner)
+ (oset pullreq head-ref .headRef.name)
+ (oset pullreq head-rev .headRefOid)
+ (oset pullreq head-user .headRef.repository.owner.login)
+ (oset pullreq head-repo .headRef.repository.nameWithOwner)
+ (oset pullreq milestone (and .milestone.id
+ (forge--object-id (oref repo id)
+ .milestone.id)))
+ (oset pullreq body (forge--sanitize-string .body))
+ (dolist (p .comments)
+ (let-alist p
+ (closql-insert
+ (forge-db)
+ (forge-pullreq-post
+ :id (forge--object-id pullreq-id .databaseId)
+ :pullreq pullreq-id
+ :number .databaseId
+ :author .author.login
+ :created .createdAt
+ :updated .updatedAt
+ :body (forge--sanitize-string .body))
+ t)))
+ (forge--update-status repo pullreq data bump initial-pull))
+ (ignore-errors
+ (forge--set-id-slot repo pullreq 'assignees .assignees))
+ (ignore-errors
+ (forge--set-id-slot repo pullreq 'review-requests
+ (--map (cdr (cadr (car it)))
+ .reviewRequests)))
+ (ignore-errors
+ (unless (magit-get-boolean "forge.kludge-for-issue-294")
+ (forge--set-id-slot repo pullreq 'labels .labels))))
+ pullreq))
+
+;;;; Notifications
+
+(cl-defmethod forge--pull-notifications
+ ((_class (subclass forge-github-repository)) githost &optional callback)
+ ;; The GraphQL API doesn't support notifications and support in the
+ ;; REST API is abysmal -- forcing us to perform a major rain dance.
+ (let ((spec (forge--get-forge-host githost t)))
+ (forge--msg nil t nil "Pulling notifications")
+ (pcase-let*
+ ((`(,_ ,apihost ,forge ,_) spec)
+ (since (forge--ghub-notifications-since forge))
+ (notifs
+ (seq-keep (lambda (data)
+ ;; Github returns notifications for repositories the
+ ;; user no longer has access to. Trying to retrieve
+ ;; information for such repositories leads to errors,
+ ;; which we suppress. See #164.
+ (with-demoted-errors "forge--pull-notifications: %S"
+ (forge--ghub-massage-notification data githost)))
+ (forge--ghub-get nil "/notifications"
+ `((all . t) ,@(and since `((since . ,since))))
+ :host apihost :unpaginate t)))
+ ;; Split into multiple requests to reduce risk of timeouts.
+ (groups (-partition-all 50 notifs))
+ (pages (length groups))
+ (page 0)
+ (topics nil))
+ (cl-labels
+ ((cb (&optional data _headers _status _req)
+ (when data
+ (setq topics (nconc topics (cdr data))))
+ (if groups
+ (let* ((query (seq-keep #'caddr (pop groups)))
+ (tries 3)
+ (errorback nil)
+ (vacuum (lambda ()
+ (ghub--graphql-vacuum
+ (cons 'query query) nil #'cb nil
+ :auth 'forge :host apihost
+ :errorback errorback))))
+ ;; Github also returns notifications for issues
+ ;; belonging to repositories for which issues
+ ;; have been disabled. Drop them and try again.
+ (setq errorback
+ (lambda (errors _headers _status _req)
+ (if (zerop tries)
+ (ghub--signal-error errors)
+ (cl-decf tries)
+ (if-let ((notfound
+ (seq-keep
+ (lambda (err)
+ (and (equal (cdr (assq 'type err))
+ "NOT_FOUND")
+ (cadr (assq 'path err))
+ (intern (cadr (assq 'path err)))))
+ (cdr errors))))
+ (progn
+ (setq query (cl-delete-if
+ (lambda (e) (memq e notfound))
+ query :key #'caar))
+ (funcall vacuum))
+ (ghub--signal-error errors)))))
+ (cl-incf page)
+ (forge--msg nil t nil
+ "Pulling notifications (page %s/%s)" page pages)
+ (funcall vacuum))
+ (forge--msg nil t t "Pulling notifications")
+ (forge--msg nil t nil "Storing notifications")
+ (forge--ghub-update-notifications notifs topics (not since))
+ (forge--msg nil t t "Storing notifications")
+ (when callback
+ (funcall callback)))))
+ (cb)))))
+
+(defun forge--ghub-notifications-since (forge)
+ (caar (forge-sql [:select :distinct [notification:updated]
+ :from [notification repository]
+ :where (and (= repository:forge $s1)
+ (= repository:id notification:repository))
+ :order-by [(desc notification:updated)]]
+ forge)))
+
+(defun forge--ghub-massage-notification (data githost)
+ (let-alist data
+ (let* ((type (intern (downcase .subject.type)))
+ (type (if (eq type 'pullrequest) 'pullreq type)))
+ (and (memq type '(pullreq issue))
+ (let* ((number (and (string-match "[0-9]*\\'" .subject.url)
+ (string-to-number (match-string 0 .subject.url))))
+ (repo (forge-get-repository
+ (list githost
+ .repository.owner.login
+ .repository.name)
+ nil :insert!))
+ (repoid (oref repo id))
+ (owner (oref repo owner))
+ (name (oref repo name))
+ (id (forge--object-id repoid (string-to-number .id)))
+ (alias (intern (concat "_" (string-replace "=" "_" id)))))
+ (list alias id
+ `((,alias repository)
+ [(name ,name)
+ (owner ,owner)]
+ ,@(cddr
+ (caddr
+ (ghub--graphql-prepare-query
+ ghub-fetch-repository
+ (if (eq type 'issue)
+ `(repository issues (issue . ,number))
+ `(repository pullRequest (pullRequest . ,number)))
+ ))))
+ repo type data))))))
+
+(defun forge--ghub-update-notifications (notifs topics initial-pull)
+ (closql-with-transaction (forge-db)
+ (pcase-dolist (`(,alias ,id ,_ ,repo ,type ,data) notifs)
+ (let-alist data
+ (and-let*
+ ((topic-data (cdr (cadr (assq alias topics))))
+ (topic (funcall (if (eq type 'issue)
+ #'forge--update-issue
+ #'forge--update-pullreq)
+ repo topic-data nil initial-pull))
+ (notif (or (forge-get-notification id)
+ (closql-insert (forge-db)
+ (forge-notification
+ :id id
+ :thread-id .id
+ :repository (oref repo id)
+ :type type
+ :topic (oref topic id)
+ :url .subject.url)))))
+ (oset notif title .subject.title)
+ (oset notif reason (intern (downcase .reason)))
+ (oset notif last-read .last_read_at)
+ (oset notif updated .updated_at))))))
+
+;;;; Miscellaneous
+
+(cl-defmethod forge--add-user-repos
+ ((class (subclass forge-github-repository)) host user)
+ (forge--fetch-user-repos
+ class (forge--as-apihost host) user
+ (apply-partially #'forge--batch-add-callback (forge--as-githost host) user)))
+
+(cl-defmethod forge--add-organization-repos
+ ((class (subclass forge-github-repository)) host org)
+ (forge--fetch-organization-repos
+ class (forge--as-apihost host) org
+ (apply-partially #'forge--batch-add-callback (forge--as-githost host) org)))
+
+(cl-defmethod forge--fetch-user-repos
+ ((_ (subclass forge-github-repository)) host user callback)
+ (ghub--graphql-vacuum
+ '(query (user
+ [(login $login String!)]
+ (repositories
+ [(:edges t)
+ (ownerAffiliations . (OWNER))]
+ name)))
+ `((login . ,user))
+ (lambda (d)
+ (funcall callback
+ (--map (alist-get 'name it)
+ (let-alist d .user.repositories))))
+ nil :auth 'forge :host host))
+
+(cl-defmethod forge--fetch-organization-repos
+ ((_ (subclass forge-github-repository)) host org callback)
+ (ghub--graphql-vacuum
+ '(query (organization
+ [(login $login String!)]
+ (repositories [(:edges t)] name)))
+ `((login . ,org))
+ (lambda (d)
+ (funcall callback
+ (--map (alist-get 'name it)
+ (let-alist d .organization.repositories))))
+ nil :auth 'forge :host host))
+
+(defun forge--batch-add-callback (host owner names)
+ (let ((repos (mapcan (lambda (name)
+ (let ((repo (forge-get-repository
+ (list host owner name)
+ nil :insert!)))
+ (and (not (forge-get-repository repo nil :tracked?))
+ (list repo))))
+ names))
+ (cb nil))
+ (setq cb (lambda ()
+ (when-let ((repo (pop repos)))
+ (forge--pull repo cb))))
+ (funcall cb)))
+
+;;; Mutations
+
+(cl-defmethod forge--submit-create-issue ((_ forge-github-repository) repo)
+ (let-alist (forge--topic-parse-buffer)
+ (forge--ghub-post repo "/repos/:owner/:repo/issues"
+ `((title . , .title)
+ (body . , .body)
+ ,@(and .labels (list (cons 'labels .labels)))
+ ,@(and .assignees (list (cons 'assignees .assignees))))
+ :callback (forge--post-submit-callback)
+ :errorback (forge--post-submit-errorback))))
+
+(cl-defmethod forge--create-pullreq-from-issue ((repo forge-github-repository)
+ (issue forge-issue)
+ source target)
+ (pcase-let* ((`(,base-remote . ,base-branch)
+ (magit-split-branch-name target))
+ (`(,head-remote . ,head-branch)
+ (magit-split-branch-name source))
+ (head-repo (forge-get-repository :stub head-remote)))
+ (forge--ghub-post repo "/repos/:owner/:repo/pulls"
+ `((issue . ,(oref issue number))
+ (base . ,base-branch)
+ (head . ,(if (equal head-remote base-remote)
+ head-branch
+ (concat (oref head-repo owner) ":"
+ head-branch)))
+ (maintainer_can_modify . t))
+ :callback (lambda (&rest _)
+ (closql-delete issue)
+ (forge-pull))
+ :errorback (lambda (&rest _) (forge-pull)))))
+
+(cl-defmethod forge--submit-create-pullreq ((_ forge-github-repository) repo)
+ (let-alist (forge--topic-parse-buffer)
+ (when (and .yaml (local-variable-p 'forge-buffer-draft-p))
+ (user-error "Cannot use yaml frontmatter and set `%s' at the same time"
+ 'forge-buffer-draft-p))
+ (pcase-let* ((`(,base-remote . ,base-branch)
+ (magit-split-branch-name forge--buffer-base-branch))
+ (`(,head-remote . ,head-branch)
+ (magit-split-branch-name forge--buffer-head-branch))
+ (head-repo (forge-get-repository :stub head-remote))
+ (url-mime-accept-string
+ ;; Support draft pull-requests.
+ "application/vnd.github.shadow-cat-preview+json"))
+ (forge--ghub-post repo "/repos/:owner/:repo/pulls"
+ `((title . , .title)
+ (body . , .body)
+ (base . ,base-branch)
+ (head . ,(if (equal head-remote base-remote)
+ head-branch
+ (concat (oref head-repo owner) ":"
+ head-branch)))
+ (draft . ,(if (local-variable-p 'forge-buffer-draft-p)
+ forge-buffer-draft-p
+ .draft))
+ (maintainer_can_modify . t))
+ :callback (forge--post-submit-callback)
+ :errorback (forge--post-submit-errorback)))))
+
+(cl-defmethod forge--submit-create-post ((_ forge-github-repository) topic)
+ (forge--ghub-post topic "/repos/:owner/:repo/issues/:number/comments"
+ `((body . ,(string-trim (buffer-string))))
+ :callback (forge--post-submit-callback)
+ :errorback (forge--post-submit-errorback)))
+
+(cl-defmethod forge--submit-edit-post ((_ forge-github-repository) post)
+ (forge--ghub-patch post
+ (cl-typecase post
+ (forge-pullreq "/repos/:owner/:repo/pulls/:number")
+ (forge-issue "/repos/:owner/:repo/issues/:number")
+ (forge-post "/repos/:owner/:repo/issues/comments/:number"))
+ (if (cl-typep post 'forge-topic)
+ (let-alist (forge--topic-parse-buffer)
+ `((title . , .title)
+ (body . , .body)))
+ `((body . ,(string-trim (buffer-string)))))
+ :callback (forge--post-submit-callback)
+ :errorback (forge--post-submit-errorback)))
+
+(cl-defmethod forge--set-topic-title
+ ((_repo forge-github-repository) topic title)
+ (forge--ghub-patch topic
+ "/repos/:owner/:repo/issues/:number"
+ `((title . ,title))
+ :callback (forge--set-field-callback topic)))
+
+(cl-defmethod forge--set-topic-state
+ ((_repo forge-github-repository) topic state)
+ (forge--ghub-patch topic
+ "/repos/:owner/:repo/issues/:number"
+ (pcase-exhaustive state
+ ;; Merging isn't done through here.
+ ('completed '((state . "closed") (state_reason . "completed")))
+ ('unplanned '((state . "closed") (state_reason . "not_planned")))
+ ('rejected '((state . "closed")))
+ ('open '((state . "open"))))
+ :callback (forge--set-field-callback topic)))
+
+(cl-defmethod forge--set-topic-draft
+ ((_repo forge-github-repository) topic value)
+ (let ((buffer (current-buffer)))
+ (ghub-graphql
+ `(mutation (,(if value
+ 'convertPullRequestToDraft
+ 'markPullRequestReadyForReview)
+ [(input $input ,(if value
+ 'ConvertPullRequestToDraftInput!
+ 'MarkPullRequestReadyForReviewInput!))]
+ (pullRequest isDraft)))
+ `((input (pullRequestId . ,(oref topic their-id))))
+ :host (oref (forge-get-repository topic) apihost)
+ :auth 'forge
+ :callback (lambda (data &rest _)
+ (if (assq 'error data)
+ (ghub--graphql-pp-response data)
+ (oset topic draft-p value)
+ (forge-refresh-buffer buffer))))))
+
+(cl-defmethod forge--set-topic-milestone
+ ((repo forge-github-repository) topic milestone)
+ (forge--ghub-patch topic
+ "/repos/:owner/:repo/issues/:number"
+ (if milestone
+ `((milestone . ,(caar (forge-sql [:select [number]
+ :from milestone
+ :where (and (= repository $s1)
+ (= title $s2))]
+ (oref repo id)
+ milestone))))
+ `((milestone . :null)))
+ :callback (forge--set-field-callback topic)))
+
+(cl-defmethod forge--set-topic-labels
+ ((_repo forge-github-repository) topic labels)
+ (funcall (if labels #'forge--ghub-put #'forge--ghub-delete)
+ topic "/repos/:owner/:repo/issues/:number/labels" nil
+ :payload labels
+ :callback (forge--set-field-callback topic)))
+
+(cl-defmethod forge--set-topic-assignees
+ ((_repo forge-github-repository) topic assignees)
+ (let ((value (mapcar #'cadr (oref topic assignees))))
+ ;; FIXME Only refresh once.
+ (when-let ((add (cl-set-difference assignees value :test #'equal)))
+ (forge--ghub-post topic "/repos/:owner/:repo/issues/:number/assignees"
+ `((assignees . ,add))
+ :callback (forge--set-field-callback topic)))
+ (when-let ((remove (cl-set-difference value assignees :test #'equal)))
+ (forge--ghub-delete topic "/repos/:owner/:repo/issues/:number/assignees"
+ `((assignees . ,remove))
+ :callback (forge--set-field-callback topic)))))
+
+(cl-defmethod forge--set-topic-review-requests
+ ((_repo forge-github-repository) topic reviewers)
+ (let ((value (mapcar #'cadr (oref topic review-requests))))
+ ;; FIXME Only refresh once.
+ (when-let ((add (cl-set-difference reviewers value :test #'equal)))
+ (forge--ghub-post topic
+ "/repos/:owner/:repo/pulls/:number/requested_reviewers"
+ `((reviewers . ,add))
+ :callback (forge--set-field-callback topic)))
+ (when-let ((remove (cl-set-difference value reviewers :test #'equal)))
+ (forge--ghub-delete topic
+ "/repos/:owner/:repo/pulls/:number/requested_reviewers"
+ `((reviewers . ,remove))
+ :callback (forge--set-field-callback topic)))))
+
+(cl-defmethod forge--delete-comment
+ ((_repo forge-github-repository) post)
+ (forge--ghub-delete post "/repos/:owner/:repo/issues/comments/:number")
+ (closql-delete post)
+ (forge-refresh-buffer))
+
+(cl-defmethod forge--topic-template-files ((repo forge-github-repository)
+ (_ (subclass forge-issue)))
+ (and-let* ((files (magit-revision-files (oref repo default-branch))))
+ (let ((case-fold-search t))
+ (if-let ((file (--first (string-match-p "\
+\\`\\(\\|docs/\\|\\.github/\\)issue_template\\(\\.[a-zA-Z0-9]+\\)?\\'" it)
+ files)))
+ (list file)
+ (setq files
+ (--filter (string-match-p "\\`\\.github/ISSUE_TEMPLATE/[^/]*" it)
+ files))
+ (if-let ((conf (cl-find-if
+ (lambda (f)
+ (equal (file-name-nondirectory f) "config.yml"))
+ files)))
+ (nconc (delete conf files)
+ (list conf))
+ files)))))
+
+(cl-defmethod forge--topic-template-files ((repo forge-github-repository)
+ (_ (subclass forge-pullreq)))
+ (and-let* ((files (magit-revision-files (oref repo default-branch))))
+ (let ((case-fold-search t))
+ (if-let ((file (--first (string-match-p "\
+\\`\\(\\|docs/\\|\\.github/\\)pull_request_template\\(\\.[a-zA-Z0-9]+\\)?\\'" it)
+ files)))
+ (list file)
+ ;; Unlike for issues, the web interface does not support
+ ;; multiple pull-request templates. The API does though,
+ ;; but due to this limitation I doubt many people use them,
+ ;; so Forge doesn't support them either.
+ ))))
+
+(cl-defmethod forge--set-default-branch ((repo forge-github-repository)
+ newname oldname)
+ (forge--ghub-post repo
+ (format "/repos/:owner/:name/branches/%s/rename" oldname)
+ `((new_name . ,newname)))
+ (message "Waiting 5 seconds for GitHub to complete rename...")
+ (sleep-for 5)
+ (message "Waiting 5 seconds for GitHub to complete rename...done")
+ (magit-call-git "fetch" "--prune" (oref repo remote))
+ (magit--set-default-branch newname oldname))
+
+(cl-defmethod forge--fork-repository ((repo forge-github-repository) fork)
+ (with-slots (owner name) repo
+ (forge--ghub-post repo
+ (format "/repos/%s/%s/forks" owner name)
+ (and (not (equal fork (ghub--username (ghub--host nil))))
+ `((organization . ,fork))))
+ (ghub-wait (format "/repos/%s/%s" fork name) nil :auth 'forge)))
+
+(cl-defmethod forge--merge-pullreq ((_repo forge-github-repository)
+ topic hash method)
+ (forge--ghub-put topic
+ "/repos/:owner/:repo/pulls/:number/merge"
+ `((merge_method . ,(symbol-name method))
+ ,@(and hash `((sha . ,hash))))))
+
+;;; Wrappers
+
+(cl-defun forge--ghub-get (obj resource
+ &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ host
+ callback errorback)
+ (declare (indent defun))
+ (ghub-get (if obj (forge--format-resource obj resource) resource)
+ params
+ :host (or host (oref (forge-get-repository obj) apihost))
+ :auth 'forge
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :callback callback :errorback errorback))
+
+(cl-defun forge--ghub-put (obj resource
+ &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ host
+ callback errorback)
+ (declare (indent defun))
+ (ghub-put (if obj (forge--format-resource obj resource) resource)
+ params
+ :host (or host (oref (forge-get-repository obj) apihost))
+ :auth 'forge
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :callback callback :errorback errorback))
+
+(cl-defun forge--ghub-post (obj resource
+ &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ host callback errorback)
+ (declare (indent defun))
+ (ghub-post (forge--format-resource obj resource)
+ params
+ :host (or host (oref (forge-get-repository obj) apihost))
+ :auth 'forge
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :callback callback :errorback errorback))
+
+(cl-defun forge--ghub-patch (obj resource
+ &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ host callback errorback)
+ (declare (indent defun))
+ (ghub-patch (forge--format-resource obj resource)
+ params
+ :host (or host (oref (forge-get-repository obj) apihost))
+ :auth 'forge
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :callback callback :errorback errorback))
+
+(cl-defun forge--ghub-delete (obj resource
+ &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ host callback errorback)
+ (declare (indent defun))
+ (ghub-delete (forge--format-resource obj resource)
+ params
+ :host (or host (oref (forge-get-repository obj) apihost))
+ :auth 'forge
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :callback callback :errorback errorback))
+
+;;; _
+(provide 'forge-github)
+;;; forge-github.el ends here
--- /dev/null
+;;; forge-gitlab.el --- Gitlab support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forge@jonas.bernoulli.dev>
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'glab)
+
+(require 'forge)
+(require 'forge-issue)
+(require 'forge-pullreq)
+
+;;; Class
+
+(defclass forge-gitlab-repository (forge-repository)
+ ((issues-url-format :initform "https://%h/%o/%n/issues")
+ (issue-url-format :initform "https://%h/%o/%n/issues/%i")
+ (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#note_%I")
+ (pullreqs-url-format :initform "https://%h/%o/%n/merge_requests")
+ (pullreq-url-format :initform "https://%h/%o/%n/merge_requests/%i")
+ (pullreq-post-url-format :initform "https://%h/%o/%n/merge_requests/%i#note_%I")
+ (commit-url-format :initform "https://%h/%o/%n/commit/%r")
+ (branch-url-format :initform "https://%h/%o/%n/commits/%r")
+ (remote-url-format :initform "https://%h/%o/%n")
+ (create-issue-url-format :initform "https://%h/%o/%n/issues/new")
+ (create-pullreq-url-format :initform "https://%h/%o/%n/merge_requests/new")
+ (pullreq-refspec :initform "+refs/merge-requests/*/head:refs/pullreqs/*")))
+
+;;; Pull
+;;;; Repository
+
+(cl-defmethod forge--pull ((repo forge-gitlab-repository)
+ &optional callback since)
+ (cl-assert (not (and since (forge-get-repository repo nil :tracked?))))
+ (setq forge--mode-line-buffer (current-buffer))
+ (forge--msg repo t nil "Pulling REPO")
+ (let ((cb (let ((buf (current-buffer))
+ (val nil))
+ (lambda (cb &optional v)
+ (when v (if val (push v val) (setq val v)))
+ (let-alist val
+ (cond
+ ((not val)
+ (forge--fetch-repository repo cb))
+ ((not (assq 'assignees val))
+ (forge--fetch-assignees repo cb))
+ ((not (assq 'forks val))
+ (forge--fetch-forks repo cb))
+ ((not (assq 'labels val))
+ (forge--fetch-labels repo cb))
+ ((and .issues_enabled
+ (not (assq 'issues val)))
+ (forge--fetch-issues repo cb since))
+ ((and .merge_requests_enabled
+ (not (assq 'pullreqs val)))
+ (forge--fetch-pullreqs repo cb since))
+ (t
+ (forge--msg repo t t "Pulling REPO")
+ (forge--msg repo t nil "Storing REPO")
+ (closql-with-transaction (forge-db)
+ (forge--update-repository repo val)
+ (forge--update-assignees repo .assignees)
+ (forge--update-labels repo .labels)
+ (dolist (v .issues) (forge--update-issue repo v))
+ (dolist (v .pullreqs) (forge--update-pullreq repo v))
+ (oset repo condition :tracked))
+ (forge--msg repo t t "Storing REPO")
+ (cond
+ ((oref repo selective-p))
+ (callback (funcall callback))
+ ((forge--maybe-git-fetch repo buf))))))))))
+ (funcall cb cb)))
+
+(cl-defmethod forge--fetch-repository ((repo forge-gitlab-repository) callback)
+ (forge--glab-get repo "/projects/:project" nil
+ :callback (lambda (value _headers _status _req)
+ (cond ((oref repo selective-p)
+ (setq value (append '((assignees) (forks) (labels)
+ (issues) (pullreqs))
+ value)))
+ ((magit-get-boolean "forge.omitExpensive")
+ (setq value (append '((assignees) (forks) (labels))
+ value))))
+ (funcall callback callback value))))
+
+(cl-defmethod forge--update-repository ((repo forge-gitlab-repository) data)
+ (let-alist data
+ (oset repo created .created_at)
+ (oset repo updated .last_activity_at)
+ (oset repo pushed nil)
+ (oset repo parent .forked_from_project.path_with_namespace)
+ (oset repo description .description)
+ (oset repo homepage nil)
+ (oset repo default-branch .default_branch)
+ (oset repo archived-p .archived)
+ (oset repo fork-p (and .forked_from_project.path_with_namespace t))
+ (oset repo locked-p nil)
+ (oset repo mirror-p .mirror)
+ (oset repo private-p (equal .visibility "private"))
+ (oset repo issues-p .issues_enabled)
+ (oset repo wiki-p .wiki_enabled)
+ (oset repo stars .star_count)
+ (oset repo watchers .star_count)))
+
+;;;; Topics
+
+(cl-defmethod forge--pull-topic ((repo forge-gitlab-repository) _topic
+ &key callback _errorback)
+ (forge--pull repo callback)) ; TODO Pull only the one topic.
+
+;;;; Issues
+
+(cl-defmethod forge--fetch-issues ((repo forge-gitlab-repository) callback since)
+ (let ((cb (let (val cur cnt pos)
+ (lambda (cb &optional v)
+ (cond
+ ((not pos)
+ (if (setq cur (setq val v))
+ (progn
+ (setq pos 1)
+ (setq cnt (length val))
+ (forge--msg nil nil nil "Pulling issue %s/%s" pos cnt)
+ (forge--fetch-issue-posts repo cur cb))
+ (forge--msg repo t t "Pulling REPO issues")
+ (funcall callback callback (cons 'issues val))))
+ (t
+ (if (setq cur (cdr cur))
+ (progn
+ (cl-incf pos)
+ (forge--msg nil nil nil "Pulling issue %s/%s" pos cnt)
+ (forge--fetch-issue-posts repo cur cb))
+ (forge--msg repo t t "Pulling REPO issues")
+ (funcall callback callback (cons 'issues val)))))))))
+ (forge--msg repo t nil "Pulling REPO issues")
+ (forge--glab-get repo "/projects/:project/issues"
+ `((per_page . 100)
+ (order_by . "updated_at")
+ ,@(and-let* ((after (or since (oref repo issues-until))))
+ `((updated_after . ,after))))
+ :unpaginate t
+ :callback (lambda (value _headers _status _req)
+ (funcall cb cb value)))))
+
+(cl-defmethod forge--fetch-issue-posts ((repo forge-gitlab-repository) cur cb)
+ (let-alist (car cur)
+ (forge--glab-get repo
+ (format "/projects/%s/issues/%s/notes" .project_id .iid)
+ '((per_page . 100))
+ :unpaginate t
+ :callback (lambda (value _headers _status _req)
+ (setf (alist-get 'notes (car cur)) value)
+ (funcall cb cb)))))
+
+(cl-defmethod forge--update-issue ((repo forge-gitlab-repository) data)
+ (closql-with-transaction (forge-db)
+ (let-alist data
+ (let* ((issue-id (forge--object-id 'forge-issue repo .iid))
+ (issue
+ (forge-issue
+ :id issue-id
+ :their-id .iid
+ :number .iid
+ :slug (format "#%s" .iid)
+ :repository (oref repo id)
+ ;; Gitlab doesn't make a distinction between completed
+ ;; and unplanned issues. Treat them all as completed.
+ :state (pcase-exhaustive .state
+ ("closed" 'completed)
+ ("opened" 'open))
+ :author .author.username
+ :title .title
+ :created .created_at
+ :updated .updated_at
+ ;; `.closed_at' may be nil even though the issues is
+ ;; closed. In such cases use 1, so that this slot
+ ;; at least can serve as a boolean.
+ :closed (or .closed_at (and (equal .state "closed") 1))
+ :locked-p .discussion_locked
+ :milestone .milestone.iid
+ :body (forge--sanitize-string .description))))
+ (closql-insert (forge-db) issue t)
+ (unless (magit-get-boolean "forge.omitExpensive")
+ (forge--set-id-slot repo issue 'assignees .assignees)
+ (forge--set-id-slot repo issue 'labels .labels))
+ (dolist (c .notes)
+ (let-alist c
+ (let ((post
+ (forge-issue-post
+ :id (forge--object-id issue-id .id)
+ :issue issue-id
+ :number .id
+ :author .author.username
+ :created .created_at
+ :updated .updated_at
+ :body (forge--sanitize-string .body))))
+ (closql-insert (forge-db) post t))))
+ (let ((until (oref repo issues-until)))
+ (when (or (not until) (string> .updated_at until))
+ (oset repo issues-until .updated_at)))
+ issue))))
+
+;;;; Pullreqs
+
+(cl-defmethod forge--fetch-pullreqs ((repo forge-gitlab-repository) callback since)
+ (let ((cb (let (val cur cnt pos)
+ (lambda (cb &optional v)
+ (cond
+ ((not pos)
+ (if (setq cur (setq val v))
+ (progn
+ (setq pos 1)
+ (setq cnt (length val))
+ (forge--msg nil nil nil "Pulling pullreq %s/%s" pos cnt)
+ (forge--fetch-pullreq-posts repo cur cb))
+ (forge--msg repo t t "Pulling REPO pullreqs")
+ (funcall callback callback (cons 'pullreqs val))))
+ ((not (assq 'source_project (car cur)))
+ (forge--fetch-pullreq-source-repo repo cur cb))
+ ((not (assq 'target_project (car cur)))
+ (forge--fetch-pullreq-target-repo repo cur cb))
+ (t
+ (if (setq cur (cdr cur))
+ (progn
+ (cl-incf pos)
+ (forge--msg nil nil nil "Pulling pullreq %s/%s" pos cnt)
+ (forge--fetch-pullreq-posts repo cur cb))
+ (forge--msg repo t t "Pulling REPO pullreqs")
+ (funcall callback callback (cons 'pullreqs val)))))))))
+ (forge--msg repo t nil "Pulling REPO pullreqs")
+ (forge--glab-get repo "/projects/:project/merge_requests"
+ `((per_page . 100)
+ (order_by . "updated_at")
+ ,@(and-let* ((after (or since (oref repo pullreqs-until))))
+ `((updated_after . ,after))))
+ :unpaginate t
+ :callback (lambda (value _headers _status _req)
+ (funcall cb cb value)))))
+
+(cl-defmethod forge--fetch-pullreq-posts
+ ((repo forge-gitlab-repository) cur cb)
+ (let-alist (car cur)
+ (forge--glab-get repo
+ (format "/projects/%s/merge_requests/%s/notes" .target_project_id .iid)
+ '((per_page . 100))
+ :unpaginate t
+ :callback (lambda (value _headers _status _req)
+ (setf (alist-get 'notes (car cur)) value)
+ (funcall cb cb)))))
+
+(cl-defmethod forge--fetch-pullreq-source-repo
+ ((repo forge-gitlab-repository) cur cb)
+ ;; If the fork no longer exists, then `.source_project_id' is nil.
+ ;; This will lead to difficulties later on but there is nothing we
+ ;; can do about it.
+ (let-alist (car cur)
+ (if .source_project_id
+ (forge--glab-get repo (format "/projects/%s" .source_project_id) nil
+ :errorback (lambda (_err _headers _status _req)
+ (setf (alist-get 'source_project (car cur)) nil)
+ (funcall cb cb))
+ :callback (lambda (value _headers _status _req)
+ (setf (alist-get 'source_project (car cur)) value)
+ (funcall cb cb)))
+ (setf (alist-get 'source_project (car cur)) nil)
+ (funcall cb cb))))
+
+(cl-defmethod forge--fetch-pullreq-target-repo
+ ((repo forge-gitlab-repository) cur cb)
+ (let-alist (car cur)
+ (forge--glab-get repo (format "/projects/%s" .target_project_id) nil
+ :errorback (lambda (_err _headers _status _req)
+ (setf (alist-get 'target_project (car cur)) nil)
+ (funcall cb cb))
+ :callback (lambda (value _headers _status _req)
+ (setf (alist-get 'target_project (car cur)) value)
+ (funcall cb cb)))))
+
+(cl-defmethod forge--update-pullreq ((repo forge-gitlab-repository) data)
+ (closql-with-transaction (forge-db)
+ (let-alist data
+ (let* ((pullreq-id (forge--object-id 'forge-pullreq repo .iid))
+ (pullreq
+ (forge-pullreq
+ :id pullreq-id
+ :their-id .iid
+ :number .iid
+ :slug (format "!%s" .iid)
+ :repository (oref repo id)
+ :state (pcase-exhaustive .state
+ ("merged" 'merged)
+ ("closed" 'rejected)
+ ("opened" 'open))
+ :author .author.username
+ :title .title
+ :created .created_at
+ :updated .updated_at
+ ;; `.merged_at' and `.closed_at' may both be nil even
+ ;; though the pullreq is merged or otherwise closed.
+ ;; In such cases use 1, so that these slots at least
+ ;; can serve as booleans.
+ :closed (or .closed_at
+ (and (member .state '("closed" "merged")) 1))
+ :merged (or .merged_at
+ (and (equal .state "merged") 1))
+ :draft-p .draft
+ :locked-p .discussion_locked
+ :editable-p .allow_maintainer_to_push
+ :cross-repo-p (not (equal .source_project_id
+ .target_project_id))
+ :base-ref .target_branch
+ :base-rev .diff_refs.start_sha
+ :base-repo .target_project.path_with_namespace
+ :head-ref .source_branch
+ :head-rev .diff_refs.head_sha
+ :head-user .source_project.owner.username
+ :head-repo .source_project.path_with_namespace
+ :milestone .milestone.iid
+ :body (forge--sanitize-string .description))))
+ (closql-insert (forge-db) pullreq t)
+ (unless (magit-get-boolean "forge.omitExpensive")
+ (forge--set-id-slot repo pullreq 'assignees .assignees)
+ (forge--set-id-slot repo pullreq 'review-requests .reviewers)
+ (forge--set-id-slot repo pullreq 'labels .labels))
+ (dolist (c .notes)
+ (let-alist c
+ (let ((post
+ (forge-pullreq-post
+ :id (forge--object-id pullreq-id .id)
+ :pullreq pullreq-id
+ :number .id
+ :author .author.username
+ :created .created_at
+ :updated .updated_at
+ :body (forge--sanitize-string .body))))
+ (closql-insert (forge-db) post t))))
+ (let ((until (oref repo pullreqs-until)))
+ (when (or (not until) (string> .updated_at until))
+ (oset repo pullreqs-until .updated_at)))
+ pullreq))))
+
+;;;; Other
+
+;; The extend of the documentation for "GET /projects/:id/users" is
+;; "Get the users list of a project." I don't know what that means,
+;; but it stands to reason that this must at least overlap with the
+;; set of users that can be assigned to topics.
+
+(cl-defmethod forge--fetch-assignees ((repo forge-gitlab-repository) callback)
+ (forge--glab-get repo "/projects/:project/users"
+ '((per_page . 100))
+ :unpaginate t
+ :callback (lambda (value _headers _status _req)
+ (funcall callback callback (cons 'assignees value)))))
+
+(cl-defmethod forge--update-assignees ((repo forge-gitlab-repository) data)
+ (oset repo assignees
+ (with-slots (id) repo
+ (mapcar (lambda (row)
+ (let-alist row
+ ;; For other forges we don't need to store `id'
+ ;; but here we do because that's what has to be
+ ;; used when assigning issues.
+ (list (forge--object-id id .id)
+ .username
+ .name
+ .id)))
+ data))))
+
+(cl-defmethod forge--fetch-forks ((repo forge-gitlab-repository) callback)
+ (forge--glab-get repo "/projects/:project/forks"
+ '((per_page . 100)
+ (simple . t))
+ :unpaginate t
+ :callback (lambda (value _headers _status _req)
+ (funcall callback callback (cons 'forks value)))))
+
+(cl-defmethod forge--update-forks ((repo forge-gitlab-repository) data)
+ (oset repo forks
+ (with-slots (id) repo
+ (mapcar (lambda (row)
+ (let-alist row
+ (nconc (forge--repository-ids
+ (eieio-object-class repo)
+ (oref repo githost)
+ .namespace.path
+ .path)
+ (list .namespace.path
+ .path))))
+ data))))
+
+(cl-defmethod forge--fetch-labels ((repo forge-gitlab-repository) callback)
+ (forge--glab-get repo "/projects/:project/labels"
+ '((per_page . 100))
+ :unpaginate t
+ :callback (lambda (value _headers _status _req)
+ (funcall callback callback (cons 'labels value)))))
+
+(cl-defmethod forge--update-labels ((repo forge-gitlab-repository) data)
+ (oset repo labels
+ (with-slots (id) repo
+ (mapcar (lambda (row)
+ (let-alist row
+ ;; We should use the label's `id' instead of its
+ ;; `name' but a topic's `labels' field is a list
+ ;; of names instead of a list of ids or an alist.
+ ;; As a result of this we cannot recognize when
+ ;; a label is renamed and a topic continues to be
+ ;; tagged with the old label name until it itself
+ ;; is modified somehow. Additionally it leads to
+ ;; name conflicts between group and project
+ ;; labels. See #160.
+ (list (forge--object-id id .name)
+ .name
+ (downcase .color)
+ .description)))
+ ;; For now simply remove one of the duplicates.
+ (cl-delete-duplicates data
+ :key (apply-partially #'alist-get 'name)
+ :test #'equal)))))
+
+;;;; Notifications
+
+;; The closest to notifications that Gitlab provides are "events" as
+;; described at https://docs.gitlab.com/ee/api/events.html. This
+;; allows us to see the last events that took place, but that is not
+;; good enough because we are mostly interested in events we haven't
+;; looked at yet. Gitlab doesn't make a distinction between unread
+;; and read events, so this is rather useless and we don't use it for
+;; the time being.
+
+;;; Mutations
+
+(cl-defmethod forge--submit-create-issue ((_ forge-gitlab-repository) repo)
+ (let-alist (forge--topic-parse-buffer)
+ (forge--glab-post repo "/projects/:project/issues"
+ `((title . , .title)
+ (description . , .body))
+ :callback (forge--post-submit-callback)
+ :errorback (forge--post-submit-errorback))))
+
+(cl-defmethod forge--submit-create-pullreq ((_ forge-gitlab-repository) base-repo)
+ (let-alist (forge--topic-parse-buffer)
+ (pcase-let* ((`(,base-remote . ,base-branch)
+ (magit-split-branch-name forge--buffer-base-branch))
+ (`(,head-remote . ,head-branch)
+ (magit-split-branch-name forge--buffer-head-branch))
+ (head-repo (forge-get-repository :stub head-remote)))
+ (forge--glab-post head-repo "/projects/:project/merge_requests"
+ `((title . ,(if (if (local-variable-p 'forge-buffer-draft-p)
+ forge-buffer-draft-p
+ .draft)
+ (concat "Draft: " .title)
+ .title))
+ (description . , .body)
+ ,@(and (not (equal head-remote base-remote))
+ `((target_project_id . ,(oref base-repo forge-id))))
+ (target_branch . ,base-branch)
+ (source_branch . ,head-branch)
+ (allow_collaboration . t))
+ :callback (forge--post-submit-callback)
+ :errorback (forge--post-submit-errorback)))))
+
+(cl-defmethod forge--submit-create-post ((_ forge-gitlab-repository) topic)
+ (forge--glab-post topic
+ (if (forge-issue-p topic)
+ "/projects/:project/issues/:number/notes"
+ "/projects/:project/merge_requests/:number/notes")
+ `((body . ,(string-trim (buffer-string))))
+ :callback (forge--post-submit-callback)
+ :errorback (forge--post-submit-errorback)))
+
+(cl-defmethod forge--submit-edit-post ((_ forge-gitlab-repository) post)
+ (forge--glab-put post
+ (cl-etypecase post
+ (forge-pullreq "/projects/:project/merge_requests/:number")
+ (forge-issue "/projects/:project/issues/:number")
+ (forge-issue-post "/projects/:project/issues/:topic/notes/:number")
+ (forge-pullreq-post "/projects/:project/merge_requests/:topic/notes/:number"))
+ (if (cl-typep post 'forge-topic)
+ (let-alist (forge--topic-parse-buffer)
+ ;; Keep Gitlab from claiming that the user
+ ;; changed the description when that isn't
+ ;; true. The same isn't necessary for the
+ ;; title; in that case Gitlab performs the
+ ;; necessary check itself.
+ `((title . , .title)
+ ,@(and (not (equal .body (oref post body)))
+ `((description . , .body)))))
+ `((body . ,(string-trim (buffer-string)))))
+ :callback (forge--post-submit-callback)
+ :errorback (forge--post-submit-errorback)))
+
+(cl-defmethod forge--set-topic-field
+ ((_repo forge-gitlab-repository) topic field value)
+ (forge--glab-put topic
+ (cl-typecase topic
+ (forge-pullreq "/projects/:project/merge_requests/:number")
+ (forge-issue "/projects/:project/issues/:number"))
+ `((,field . ,value))
+ :callback (forge--set-field-callback topic)))
+
+(cl-defmethod forge--set-topic-title
+ ((repo forge-gitlab-repository) topic title)
+ (forge--set-topic-field repo topic 'title title))
+
+(cl-defmethod forge--set-topic-state
+ ((repo forge-gitlab-repository) topic state)
+ (forge--set-topic-field repo topic 'state_event
+ (pcase-exhaustive state
+ ;; Merging isn't done through here.
+ ('completed "close")
+ ('unplanned "close")
+ ('rejected "close")
+ ('open "reopen"))))
+
+(cl-defmethod forge--set-topic-draft
+ ((repo forge-gitlab-repository) topic value)
+ (let ((buffer (current-buffer)))
+ (glab-graphql
+ `(mutation (mergeRequestSetDraft
+ [(input $input MergeRequestSetDraftInput!)]
+ (mergeRequest iid draft)))
+ `((input (projectPath . ,(oref repo slug))
+ (iid . ,(number-to-string (oref topic number)))
+ (draft . ,value)))
+ :host (oref (forge-get-repository topic) apihost)
+ :auth 'forge
+ :callback (lambda (data &rest _)
+ (if (assq 'error data)
+ (ghub--graphql-pp-response data)
+ (oset topic draft-p value)
+ (forge-refresh-buffer buffer))))))
+
+(cl-defmethod forge--set-topic-labels
+ ((repo forge-gitlab-repository) topic labels)
+ (forge--set-topic-field repo topic 'labels
+ (string-join labels ",")))
+
+(cl-defmethod forge--set-topic-assignees
+ ((repo forge-gitlab-repository) topic assignees)
+ (let ((users (mapcar #'cdr (oref repo assignees))))
+ (cl-typecase topic
+ (forge-pullreq ; Can only be assigned to a single user.
+ (forge--set-topic-field repo topic 'assignee_id
+ (or (caddr (assoc (car assignees) users))
+ 0)))
+ (forge-issue
+ (forge--set-topic-field repo topic 'assignee_ids
+ (or (--map (caddr (assoc it users)) assignees)
+ 0))))))
+
+(cl-defmethod forge--set-topic-review-requests
+ ((repo forge-gitlab-repository) topic reviewers)
+ (let ((users (mapcar #'cdr (oref repo assignees))))
+ (forge--set-topic-field repo topic 'reviewer_ids
+ (or (--map (caddr (assoc it users)) reviewers)
+ 0))))
+
+(cl-defmethod forge--delete-comment
+ ((_repo forge-gitlab-repository) post)
+ (forge--glab-delete post
+ (cl-etypecase post
+ (forge-pullreq-post
+ "/projects/:project/merge_requests/:topic/notes/:number")
+ (forge-issue-post
+ "/projects/:project/issues/:topic/notes/:number")))
+ (closql-delete post)
+ (forge-refresh-buffer))
+
+(cl-defmethod forge--topic-template-files ((repo forge-gitlab-repository)
+ (_ (subclass forge-issue)))
+ (--filter (string-match-p "\\`\\.gitlab/issue_templates/.+\\.md\\'" it)
+ (magit-revision-files (oref repo default-branch))))
+
+(cl-defmethod forge--topic-template-files ((repo forge-gitlab-repository)
+ (_ (subclass forge-pullreq)))
+ (--filter (string-match-p "\\`\\.gitlab/merge_request_templates/.+\\.md\\'" it)
+ (magit-revision-files (oref repo default-branch))))
+
+(cl-defmethod forge--fork-repository ((repo forge-gitlab-repository) fork)
+ (with-slots (owner name) repo
+ (forge--glab-post repo (format "/projects/%s%%2F%s/fork" owner name)
+ (and (not (equal fork (ghub--username (ghub--host nil))))
+ `((namespace . ,fork)))
+ :noerror t)
+ (ghub-wait (format "/projects/%s%%2F%s" fork name)
+ nil :auth 'forge :forge 'gitlab)))
+
+(cl-defmethod forge--merge-pullreq ((_repo forge-gitlab-repository)
+ topic hash method)
+ (forge--glab-put topic
+ "/projects/:project/merge_requests/:number/merge"
+ `((squash . ,(eq method 'squash))
+ ,@(and hash `((sha . ,hash))))))
+
+;;; Wrappers
+
+(cl-defun forge--glab-get (obj resource
+ &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ host callback errorback)
+ (declare (indent defun))
+ (glab-get (if obj (forge--format-resource obj resource) resource)
+ params
+ :host (or host (oref (forge-get-repository obj) apihost))
+ :auth 'forge
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :callback callback
+ :errorback (or errorback (and callback t))))
+
+(cl-defun forge--glab-put (obj resource
+ &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ host callback errorback)
+ (declare (indent defun))
+ (glab-put (if obj (forge--format-resource obj resource) resource)
+ params
+ :host (or host (oref (forge-get-repository obj) apihost))
+ :auth 'forge
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :callback callback
+ :errorback (or errorback (and callback t))))
+
+(cl-defun forge--glab-post (obj resource
+ &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ host callback errorback)
+ (declare (indent defun))
+ (glab-post (forge--format-resource obj resource)
+ params
+ :host (or host (oref (forge-get-repository obj) apihost))
+ :auth 'forge
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :callback callback
+ :errorback (or errorback (and callback t))))
+
+(cl-defun forge--glab-delete (obj resource
+ &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ host callback errorback)
+ (declare (indent defun))
+ (glab-delete (forge--format-resource obj resource)
+ params
+ :host (or host (oref (forge-get-repository obj) apihost))
+ :auth 'forge
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :callback callback
+ :errorback (or errorback (and callback t))))
+
+;;; _
+(provide 'forge-gitlab)
+;;; forge-gitlab.el ends here
--- /dev/null
+;;; forge-gogs.el --- Gogs support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'gogs)
+(require 'forge)
+
+;;; Class
+
+(defclass forge-gogs-repository (forge-unusedapi-repository)
+ ((issues-url-format :initform "https://%h/%o/%n/issues")
+ (issue-url-format :initform "https://%h/%o/%n/issues/%i")
+ (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#issuecomment-%I")
+ (pullreqs-url-format :initform "https://%h/%o/%n/pulls")
+ (pullreq-url-format :initform "https://%h/%o/%n/pulls/%i")
+ (pullreq-post-url-format :initform "https://%h/%o/%n/pulls/%i#issuecomment-%I")
+ (commit-url-format :initform "https://%h/%o/%n/commit/%r")
+ (branch-url-format :initform "https://%h/%o/%n/commits/%r")
+ (remote-url-format :initform "https://%h/%o/%n")
+ (create-issue-url-format :initform "https://%h/%o/%n/issues/new")
+ (create-pullreq-url-format :initform "https://%h/%o/%n/pulls") ; sic
+ (pullreq-refspec :initform "+refs/pull/*/head:refs/pullreqs/*")))
+
+;;; _
+(provide 'forge-gogs)
+;;; forge-gogs.el ends here
--- /dev/null
+;;; forge-issue.el --- Issue support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'forge)
+(require 'forge-post)
+(require 'forge-topic)
+
+;;; Classes
+
+(defclass forge-issue (forge-topic)
+ ((closql-table :initform 'issue)
+ (closql-primary-key :initform 'id)
+ (closql-order-by :initform [(desc number)])
+ (closql-foreign-key :initform 'repository)
+ (closql-class-prefix :initform "forge-")
+ (id :initarg :id)
+ (repository :initarg :repository)
+ (number :initarg :number)
+ (state :initarg :state)
+ (author :initarg :author)
+ (title :initarg :title)
+ (created :initarg :created)
+ (updated :initarg :updated :initform nil)
+ (closed :initarg :closed)
+ (status :initarg :status :initform nil)
+ (locked-p :initarg :locked-p)
+ (milestone :initarg :milestone)
+ (body :initarg :body)
+ (assignees :closql-tables (issue-assignee assignee))
+ (project-cards) ; projectsCards
+ (edits) ; userContentEdits
+ (labels :closql-tables (issue-label label))
+ (participants)
+ (posts :closql-class forge-issue-post)
+ (reactions)
+ (timeline)
+ (marks :closql-tables (issue-mark mark))
+ (note :initarg :note :initform nil)
+ (their-id :initarg :their-id)
+ (slug :initarg :slug)
+ (saved-p :initarg :saved-p :initform nil)
+ ))
+
+(cl-defmethod closql-dref ((obj forge-issue) (_(eql assignees)))
+ (forge-sql-cdr
+ [:select assignee:* :from assignee
+ :join issue-assignee :on (= issue-assignee:id assignee:id)
+ :where (= issue-assignee:issue $s1)
+ :order-by [(asc login)]]
+ (closql--oref obj 'id)))
+
+(cl-defmethod closql-dref ((obj forge-issue) (_(eql labels)))
+ (forge-sql-cdr
+ [:select label:* :from label
+ :join issue-label :on (= issue-label:id label:id)
+ :where (= issue-label:issue $s1)
+ :order-by [(asc name)]]
+ (closql--oref obj 'id)))
+
+(cl-defmethod closql-dref ((obj forge-issue) (_(eql marks)))
+ (forge-sql-cdr
+ [:select mark:* :from mark
+ :join issue-mark :on (= issue-mark:id mark:id)
+ :where (= issue-mark:issue $s1)
+ :order-by [(asc name)]]
+ (closql--oref obj '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
+;;;; Get
+
+(cl-defmethod forge-get-repository ((post forge-issue-post))
+ (forge-get-repository (forge-get-issue post)))
+
+(cl-defmethod forge-get-topic ((post forge-issue-post))
+ (forge-get-issue post))
+
+(cl-defmethod forge-get-issue ((issue forge-issue))
+ issue)
+
+(cl-defmethod forge-get-issue ((repo forge-repository) number)
+ (closql-get (forge-db)
+ (forge--object-id 'forge-issue repo number)
+ 'forge-issue))
+
+(cl-defmethod forge-get-issue ((number integer))
+ (and-let* ((repo (forge-get-repository :tracked nil 'notatpt)))
+ (forge-get-issue repo number)))
+
+(cl-defmethod forge-get-issue ((id string))
+ (closql-get (forge-db) id 'forge-issue))
+
+(cl-defmethod forge-get-issue ((post forge-issue-post))
+ (closql-get (forge-db)
+ (oref post issue)
+ 'forge-issue))
+
+;;;; Current
+
+(defun forge-current-issue (&optional demand)
+ "Return the issue at point or being visited.
+If there is no such issue and DEMAND is non-nil, then signal
+an error."
+ (or (forge-issue-at-point)
+ (and (forge-issue-p forge-buffer-topic)
+ forge-buffer-topic)
+ (and demand (user-error "No current issue"))))
+
+(defun forge-issue-at-point (&optional demand)
+ "Return the issue at point.
+If there is no such issue and DEMAND is non-nil, then signal
+an error."
+ (or (thing-at-point 'forge-issue)
+ (magit-section-value-if 'issue)
+ (and demand (user-error "No issue at point"))))
+
+(put 'forge-issue 'thing-at-point #'forge-thingatpt--issue)
+(defun forge-thingatpt--issue ()
+ (and-let* (((thing-at-point-looking-at "#\\([0-9]+\\)\\_>"))
+ (number (string-to-number (match-string 1)))
+ (repo (forge--repo-for-thingatpt)))
+ (forge-get-issue repo number)))
+
+;;; Read
+
+(defun forge-read-issue (prompt)
+ "Read an active issue with completion using PROMPT.
+
+Open, unread and pending issues are considered active.
+Default to the current issue, even if it isn't active.
+
+\\<forge-read-topic-minibuffer-map>While completion is in \
+progress, \\[forge-read-topic-lift-limit] lifts the limit, extending
+the completion candidates to include all issues.
+
+If `forge-limit-topic-choices' is nil, then all candidates
+can be selected from the start."
+ (forge--read-topic prompt
+ #'forge-current-issue
+ (forge--topics-spec :type 'issue :active t)
+ (forge--topics-spec :type 'issue :active nil :state nil)))
+
+(defun forge-read-open-issue (prompt)
+ "Read an open issue with completion using PROMPT."
+ (let* ((current (forge-current-issue))
+ (repo (forge-get-repository (or current :tracked)))
+ (default (and current (forge--format-topic-line current)))
+ (alist (forge--topic-collection
+ (forge--list-topics
+ (forge--topics-spec :type 'issue :state 'open)
+ repo)))
+ (choices (mapcar #'car alist))
+ (choice (magit-completing-read prompt choices nil t nil nil default)))
+ (cdr (assoc choice alist))))
+
+;;; Insert
+
+(defvar-keymap forge-issues-section-map
+ :parent forge-common-map
+ "<remap> <magit-browse-thing>" #'forge-browse-issues
+ "<remap> <magit-visit-thing>" #'forge-list-issues
+ "<remap> <forge--list-menu>" #'forge-topics-menu
+ "<remap> <forge--item-menu>" #'forge-topic-menu
+ "C-c C-n" #'forge-create-issue)
+
+(defvar-keymap forge-issue-section-map
+ :parent forge-common-map
+ "<remap> <magit-visit-thing>" #'forge-visit-this-topic
+ "<remap> <forge--list-menu>" #'forge-topics-menu
+ "<remap> <forge--item-menu>" #'forge-topic-menu)
+
+(cl-defun forge-insert-issues (&optional (spec nil sspec) heading)
+ "Insert a list of issues, according to `forge--buffer-topics-spec'.
+Optional SPEC can be used to override that filtering specification,
+and optional HEADING to change the section heading."
+ (when-let (((forge-db t))
+ (repo (forge-get-repository :tracked?))
+ ((oref repo issues-p))
+ (spec (if sspec spec (forge--clone-buffer-topics-spec)))
+ ((memq (oref spec type) '(topic issue))))
+ (oset spec type 'issue)
+ (forge--insert-topics 'issues
+ (or heading "Issues")
+ (forge--list-topics spec repo))))
+
+;;; _
+(provide 'forge-issue)
+;;; forge-issue.el ends here
--- /dev/null
+;;; forge-notify.el --- Notify support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'forge)
+(require 'forge-topic)
+
+;;; Class
+
+(defclass forge-notification (forge-object)
+ ((closql-class-prefix :initform "forge-")
+ (closql-table :initform 'notification)
+ (closql-primary-key :initform 'id)
+ (closql-order-by :initform [(desc id)])
+ (id :initarg :id)
+ (thread-id :initarg :thread-id)
+ (repository :initarg :repository)
+ (type :initarg :type)
+ (topic :initarg :topic)
+ (url :initarg :url)
+ (title :initarg :title)
+ (reason :initarg :reason)
+ (last-read :initarg :last-read)
+ (updated :initarg :updated)))
+
+;;; Query
+;;;; Get
+
+(cl-defmethod forge-get-repository ((notify forge-notification))
+ "Return the object for the repository that NOTIFY belongs to."
+ (and-let* ((id (oref notify repository)))
+ (closql-get (forge-db) id 'forge-repository)))
+
+(cl-defmethod forge-get-topic ((notify forge-notification))
+ (and-let* ((repo (forge-get-repository notify)))
+ (forge-get-topic repo (oref notify topic))))
+
+(cl-defmethod forge-get-notification ((id string))
+ (closql-get (forge-db) id 'forge-notification))
+
+(cl-defmethod forge-get-notification ((topic forge-topic))
+ (and-let* ((row (car (forge-sql [:select * :from notification
+ :where (and (= repository $s1)
+ (= topic $s2))]
+ (oref topic repository)
+ (oref topic number)))))
+ (closql--remake-instance 'forge-notification (forge-db) row)))
+
+;;;; Current
+
+(defun forge-current-notification (&optional demand)
+ "Return the current notification, casting a topic if necessary.
+If there is no such notification and DEMAND is non-nil, then
+signal an error."
+ (or (magit-section-value-if 'notification)
+ (and-let* ((topic (forge-current-topic)))
+ (forge-get-notification topic))
+ (and demand (user-error "No current notification"))))
+
+(defun forge-notification-at-point (&optional demand)
+ "Return the notification at point, casting a topic if necessary.
+If there is no such notification and DEMAND is non-nil, then
+signal an error."
+ (or (magit-section-value-if 'notification)
+ (and-let* ((topic (forge-topic-at-point)))
+ (forge-get-notification topic))
+ (and demand (user-error "No notification at point"))))
+
+;;;; List
+
+(defun forge--ls-notifications (status)
+ (let* ((status (ensure-list status))
+ (savedp (memq 'saved status))
+ (status (remq 'saved status)))
+ (mapcar
+ (lambda (row) (closql--remake-instance 'forge-notification (forge-db) row))
+ (if (seq-set-equal-p status '(unread pending done) #'eq)
+ (forge-sql [:select * :from notification :order-by [(desc updated)]])
+ (forge-sql
+ `[:select :distinct notification:*
+ :from [notification (as issue topic)]
+ :where (and (= notification:topic topic:id)
+ ,@(and status '((in topic:status $v1)))
+ ,@(and savedp '((= topic:saved-p 't))))
+ :union
+ :select :distinct notification:*
+ :from [notification (as pullreq topic)]
+ :where (and (= notification:topic topic:id)
+ ,@(and status '((in topic:status $v1)))
+ ,@(and savedp '((= topic:saved-p 't))))
+ :order-by [(desc notification:updated)]]
+ (vconcat status))))))
+
+;;; Mode
+
+(defvar-keymap forge-notifications-mode-map
+ :doc "Keymap for `forge-notifications-mode'."
+ :parent (make-composed-keymap forge-common-map magit-mode-map)
+ "<remap> <magit-refresh>" #'magit-refresh-buffer
+ "<remap> <forge--list-menu>" #'forge-notifications-menu)
+
+(define-derived-mode forge-notifications-mode magit-mode "Forge Notifications"
+ "Major mode for looking at forge notifications."
+ :interactive nil
+ (magit-hack-dir-local-variables))
+
+(defun forge-notifications-setup-buffer ()
+ (magit-setup-buffer-internal #'forge-notifications-mode nil
+ '((default-directory "/")
+ (forge-buffer-unassociated-p t))
+ (get-buffer-create "*forge-notifications*")))
+
+(defun forge-notifications-refresh-buffer ()
+ (magit-set-header-line-format (forge-notifications-buffer-desc))
+ (forge-insert-notifications))
+
+(defun forge-notifications-buffer-desc ()
+ (let ((status forge-notifications-selection))
+ (cond
+ ((not (listp status))
+ (format "%s notifications" (capitalize (symbol-name status))))
+ ((seq-set-equal-p status '(unread pending)) "Inbox")
+ ((seq-set-equal-p status '(unread pending done)) "All notifications")
+ ((format "Notifications %s" status)))))
+
+(defvar forge-notifications-display-style 'flat)
+(defvar forge-notifications-selection '(unread pending))
+
+;;; Commands
+
+(transient-define-prefix forge-notifications-menu ()
+ "Control list of notifications and notification at point."
+ :transient-suffix t
+ :transient-non-suffix #'transient--do-call
+ :transient-switch-frame nil
+ :refresh-suffixes t
+ :environment #'forge--menu-environment
+ :column-widths forge--topic-menus-column-widths
+ [:hide always ("q" forge-menu-quit-list)]
+ [forge--topic-menus-group
+ ["Selection"
+ ("I" forge-notifications-display-inbox)
+ ("S" forge-notifications-display-saved)
+ ("D" forge-notifications-display-done)
+ ("A" forge-notifications-display-all)]]
+ [forge--lists-group
+ ["Display"
+ ("-F" forge-notifications-style-flat)
+ ("-G" forge-notifications-style-nested)
+ ("-H" forge-toggle-topic-legend)]]
+ [forge--topic-legend-group]
+ (interactive)
+ (unless (derived-mode-p 'forge-notifications-mode)
+ (forge-list-notifications))
+ (transient-setup 'forge-notifications-menu))
+
+(transient-augment-suffix forge-notifications-menu
+ :transient #'transient--do-replace
+ :if-mode 'forge-notifications-mode
+ :inapt-if (lambda () (eq (oref transient--prefix command) 'forge-notifications-menu))
+ :inapt-face 'forge-suffix-active)
+
+;;;###autoload(autoload 'forge-list-notifications "forge-notify" nil t)
+(transient-define-suffix forge-list-notifications ()
+ "List notifications."
+ :inapt-if-mode 'forge-notifications-mode
+ :inapt-face 'forge-suffix-active
+ (declare (interactive-only nil))
+ (interactive)
+ (forge-notifications-setup-buffer)
+ (transient-setup 'forge-notifications-menu))
+
+(transient-define-suffix forge-notifications-display-inbox ()
+ "List unread and pending notifications."
+ :description "inbox"
+ :inapt-if (lambda () (equal forge-notifications-selection '(unread pending)))
+ :inapt-face 'forge-suffix-active
+ (interactive)
+ (unless (derived-mode-p 'forge-notifications-mode)
+ (user-error "Not in notification buffer"))
+ (setq forge-notifications-selection '(unread pending))
+ (forge-refresh-buffer))
+
+(transient-define-suffix forge-notifications-display-saved ()
+ "List saved notifications."
+ :description "saved"
+ :inapt-if (lambda () (eq forge-notifications-selection 'saved))
+ :inapt-face 'forge-suffix-active
+ (interactive)
+ (unless (derived-mode-p 'forge-notifications-mode)
+ (user-error "Not in notification buffer"))
+ (setq forge-notifications-selection 'saved)
+ (forge-refresh-buffer))
+
+(transient-define-suffix forge-notifications-display-done ()
+ "List done notifications."
+ :description "done"
+ :inapt-if (lambda () (eq forge-notifications-selection 'done))
+ :inapt-face 'forge-suffix-active
+ (interactive)
+ (unless (derived-mode-p 'forge-notifications-mode)
+ (user-error "Not in notification buffer"))
+ (setq forge-notifications-selection 'done)
+ (forge-refresh-buffer))
+
+(transient-define-suffix forge-notifications-display-all ()
+ "List all notifications."
+ :description "all"
+ :inapt-if (lambda () (equal forge-notifications-selection '(unread pending done)))
+ :inapt-face 'forge-suffix-active
+ (interactive)
+ (unless (derived-mode-p 'forge-notifications-mode)
+ (user-error "Not in notification buffer"))
+ (setq forge-notifications-selection '(unread pending done))
+ (forge-refresh-buffer))
+
+(transient-define-suffix forge-notifications-style-flat ()
+ "Show a flat notification list."
+ :description "single list"
+ :inapt-if (lambda () (eq forge-notifications-display-style 'flat))
+ :inapt-face 'forge-suffix-active
+ (interactive)
+ (unless (derived-mode-p 'forge-notifications-mode)
+ (user-error "Not in notification buffer"))
+ (setq forge-notifications-display-style 'flat)
+ (forge-refresh-buffer))
+
+(transient-define-suffix forge-notifications-style-nested ()
+ "Group notifications by repository."
+ :description "group by repo"
+ :inapt-if (lambda () (eq forge-notifications-display-style 'nested))
+ :inapt-face 'forge-suffix-active
+ (interactive)
+ (unless (derived-mode-p 'forge-notifications-mode)
+ (user-error "Not in notification buffer"))
+ (setq forge-notifications-display-style 'nested)
+ (forge-refresh-buffer))
+
+;;; Sections
+
+(defclass forge-repository-section (magit-section)
+ ((type :initform 'forge-repo)
+ (keymap :initform 'forge-repository-section-map)))
+
+(define-obsolete-variable-alias 'forge-forge-repo-section-map
+ 'forge-repository-section-map "Forge 0.4.0")
+
+(defvar-keymap forge-repository-section-map
+ "<remap> <magit-browse-thing>" #'forge-browse-this-repository
+ "<remap> <magit-visit-thing>" #'forge-visit-this-repository)
+
+(defun forge-insert-notifications ()
+ (let ((notifs (forge--ls-notifications forge-notifications-selection)))
+ (magit-insert-section (notifications)
+ (cond
+ ((not notifs)
+ (insert "(empty)\n"))
+ ((eq forge-notifications-display-style 'flat)
+ (magit-insert-section-body
+ (dolist (notif notifs)
+ (forge-insert-notification notif))
+ (insert ?\n)))
+ ((pcase-dolist (`(,_ . ,notifs)
+ (--group-by (oref it repository) notifs))
+ (let ((repo (forge-get-repository (car notifs))))
+ (magit-insert-section (forge-repo repo)
+ (magit-insert-heading
+ (concat (propertize (oref repo slug) 'font-lock-face 'bold)
+ (format " (%s)" (length notifs))))
+ (magit-insert-section-body
+ (dolist (notif notifs)
+ (forge-insert-notification notif))
+ (insert ?\n))))))))))
+
+(defun forge-insert-notification (notif)
+ (with-slots (type title url) notif
+ (pcase type
+ ((or 'issue 'pullreq)
+ (forge--insert-topic (forge-get-topic notif)))
+ ('commit
+ (magit-insert-section (ncommit nil) ; !commit
+ (string-match "[^/]*\\'" url)
+ (insert
+ (format "%s %s\n"
+ (propertize (substring (match-string 0 url)
+ 0 (magit-abbrev-length))
+ 'font-lock-face 'magit-hash)
+ (magit-log-propertize-keywords
+ nil
+ (propertize title 'font-lock-face
+ (if-let ((topic (oref notif topic))
+ ((eq (oref topic status) 'unread)))
+ 'forge-topic-unread
+ 'forge-topic-open)))))))
+ (_
+ ;; The documentation does not mention what "types"
+ ;; exist. Make it obvious that this is something
+ ;; we do not know how to handle properly yet.
+ (magit-insert-section (notification notif)
+ (insert (propertize (format "(%s) %s\n" type title)
+ 'font-lock-face 'error)))))))
+
+;;; _
+(provide 'forge-notify)
+;;; forge-notify.el ends here
--- /dev/null
+;; -*- no-byte-compile: t; lexical-binding: nil -*-
+(define-package "forge" "20241223.1032"
+ "Access Git forges from Magit."
+ '((emacs "29.1")
+ (compat "30.0.0.0")
+ (closql "2.1.0")
+ (dash "2.19.1")
+ (emacsql "4.1.0")
+ (ghub "4.2.0")
+ (let-alist "1.0.6")
+ (magit "4.1.3")
+ (markdown-mode "2.6")
+ (seq "2.24")
+ (transient "0.8.0")
+ (yaml "0.5.5"))
+ :url "https://github.com/magit/forge"
+ :commit "8bace81bce397af6942c7efe012498dc181466d1"
+ :revdesc "8bace81bce39"
+ :keywords '("git" "tools" "vc")
+ :authors '(("Jonas Bernoulli" . "emacs.forgeNOSPAMjonas.bernoulli.dev"))
+ :maintainers '(("Jonas Bernoulli" . "emacs.forgeNOSPAMjonas.bernoulli.dev")))
--- /dev/null
+;;; forge-post.el --- Post support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'markdown-mode)
+
+(require 'forge)
+
+;;; Options
+
+(defcustom forge-post-mode-hook
+ '(visual-line-mode
+ turn-on-flyspell)
+ "Hook run after entering Forge-Post mode."
+ :package-version '(forge . "0.2.0")
+ :group 'forge
+ :type 'hook
+ :options '(visual-line-mode
+ turn-on-flyspell))
+
+(defcustom forge-buffer-draft-p nil
+ "Whether new pull-requests start out as drafts by default.
+
+The buffer-local value is used to keep track of the draft status
+of the current pull-request."
+ :package-version '(forge . "0.4.0")
+ :group 'forge
+ :type 'boolean)
+
+;;; Class
+
+(defclass forge-post (forge-object) () :abstract t)
+
+;;; Query
+;;;; Get
+
+(cl-defmethod forge-get-parent ((post forge-post))
+ (forge-get-topic post))
+
+(cl-defmethod forge-get-repository ((post forge-post))
+ (forge-get-repository (forge-get-topic post)))
+
+;;;; Current
+
+(defun forge-post-at-point (&optional assert)
+ "Return the post at point.
+If there is no such post and DEMAND is non-nil, then signal
+an error."
+ (or (magit-section-value-if '(issue pullreq post))
+ (and assert (user-error "There is no post at point"))))
+
+(defun forge-comment-at-point (&optional assert)
+ "Return the comment at point.
+If there is no such comment and DEMAND is non-nil, then signal
+an error."
+ (or (and (magit-section-value-if '(post))
+ (let ((post (oref (magit-current-section) value)))
+ (and (or (forge-pullreq-post-p post)
+ (forge-issue-post-p post))
+ post)))
+ (and assert (user-error "There is no comment at point"))))
+
+;;; Utilities
+
+(cl-defmethod forge--format ((post forge-post) slot &optional spec)
+ (forge--format (forge-get-topic post) slot
+ `(,@spec (?I . ,(oref post number)))))
+
+;;; Mode
+
+(defvar-keymap forge-post-mode-map
+ "C-c C-e" #'forge-post-dispatch
+ "C-c C-c" #'forge-post-submit
+ "<remap> <evil-save-and-close>" #'forge-post-submit
+ "<remap> <evil-save-modified-and-close>" #'forge-post-submit
+ "C-c C-k" #'forge-post-cancel
+ "<remap> <kill-buffer>" #'forge-post-cancel
+ "<remap> <ido-kill-buffer>" #'forge-post-cancel
+ "<remap> <iswitchb-kill-buffer>" #'forge-post-cancel
+ "<remap> <evil-quit>" #'forge-post-cancel)
+
+(define-derived-mode forge-post-mode gfm-mode "Forge-Post"
+ "Major mode for editing topic posts."
+ :interactive nil)
+
+(defvar-local forge--buffer-base-branch nil)
+(defvar-local forge--buffer-head-branch nil)
+(defvar-local forge--buffer-post-object nil)
+(defvar-local forge--buffer-issue nil)
+(defvar-local forge--submit-post-function nil)
+(defvar-local forge--cancel-post-function nil)
+(defvar-local forge--pre-post-buffer nil)
+(make-variable-buffer-local 'forge-buffer-draft-p)
+
+(defun forge--prepare-post-buffer (filename &optional header source target)
+ (let ((file (convert-standard-filename
+ (expand-file-name (concat "magit/posts/" filename)
+ (magit-gitdir)))))
+ (make-directory (file-name-directory file) t)
+ (let ((prevbuf (current-buffer))
+ (resume (and (file-exists-p file)
+ (> (file-attribute-size (file-attributes file)) 0)))
+ (buf (find-file-noselect file)))
+ (with-current-buffer buf
+ (forge-post-mode)
+ (when header
+ (magit-set-header-line-format header))
+ (setq forge--pre-post-buffer prevbuf)
+ (when resume
+ (forge--display-post-buffer buf)
+ (when (magit-read-char-case "A draft already exists. " nil
+ (?r "[r]esume editing existing draft")
+ (?d "[d]iscard draft and start over" t))
+ (erase-buffer)
+ (setq resume nil)))
+ (when (and (not resume) (string-prefix-p "new" filename))
+ (let-alist (forge--topic-template
+ (forge-get-repository :tracked)
+ (if source 'forge-pullreq 'forge-issue))
+ (cond
+ (.url
+ (browse-url .url)
+ (forge-post-cancel)
+ (setq buf nil)
+ (message "Using browser to visit %s instead of opening an issue"
+ .url))
+ (.name
+ ;; A Github issue with yaml frontmatter.
+ (save-excursion (insert .text))
+ (unless (re-search-forward "^title: " nil t)
+ (when (re-search-forward "^---" nil t 2)
+ (beginning-of-line)
+ (insert "title: \n")
+ (backward-char))))
+ (t
+ (insert "# ")
+ (let ((single
+ (and source
+ (= (car (magit-rev-diff-count source target)) 1))))
+ (save-excursion
+ (when single
+ ;; A pull-request.
+ (magit-rev-insert-format "%B" source))
+ (when .text
+ (if single
+ (insert "-------\n")
+ (insert "\n"))
+ (insert "\n" .text)))))))))
+ buf)))
+
+(defun forge--display-post-buffer (buf)
+ (magit-display-buffer buf #'display-buffer))
+
+(defun forge-post-cancel ()
+ "Cancel the post that is being edited in the current buffer."
+ (interactive)
+ (save-buffer)
+ (if-let ((fn forge--cancel-post-function))
+ (funcall fn forge--buffer-post-object)
+ (magit-mode-bury-buffer 'kill)))
+
+(defun forge-post-submit ()
+ "Submit the post that is being edited in the current buffer."
+ (interactive)
+ (save-buffer)
+ (if-let ((fn forge--submit-post-function))
+ (funcall fn
+ (forge-get-repository forge--buffer-post-object)
+ forge--buffer-post-object)
+ (error "forge--submit-post-function is nil")))
+
+(defun forge--post-submit-callback ()
+ (let* ((file buffer-file-name)
+ (editbuf (current-buffer))
+ (prevbuf forge--pre-post-buffer)
+ (topic (ignore-errors (forge-get-topic forge--buffer-post-object)))
+ (repo (forge-get-repository topic)))
+ (lambda (value headers status req)
+ (run-hook-with-args 'forge-post-submit-callback-hook
+ value headers status req)
+ (delete-file file t)
+ (let ((dir (file-name-directory file)))
+ (unless (cddr (directory-files dir nil nil t))
+ (delete-directory dir nil t)))
+ (when (buffer-live-p editbuf)
+ (with-current-buffer editbuf
+ (magit-mode-bury-buffer 'kill)))
+ (with-current-buffer
+ (if (buffer-live-p prevbuf) prevbuf (current-buffer))
+ (if (and topic
+ (forge--childp repo 'forge-github-repository)
+ (oref repo selective-p))
+ (forge--pull-topic repo topic)
+ (forge-pull))))))
+
+(defun forge--post-submit-errorback ()
+ (lambda (error &rest _)
+ (error "Failed to submit post: %S" error)))
+
+(transient-define-prefix forge-post-dispatch ()
+ "Dispatch a post creation command."
+ ["Variables"
+ ("d" "Create draft" forge-post-toggle-draft)]
+ ["Act"
+ ("C-c" "Submit" forge-post-submit)
+ ("C-k" "Cancel" forge-post-cancel)])
+
+(transient-define-infix forge-post-toggle-draft ()
+ "Toggle whether the pull-request being created is a draft."
+ :class 'transient-lisp-variable
+ :variable 'forge-buffer-draft-p
+ :reader (lambda (&rest _) (not forge-buffer-draft-p))
+ :if (lambda () (equal (file-name-nondirectory buffer-file-name) "new-pullreq")))
+
+;;; Notes
+
+(defclass forge-note (forge-post) ())
+
+(defvar-keymap forge-note-section-map
+ "<remap> <magit-edit-thing>" #'forge-edit-topic-note)
+
+(defun forge--save-note (_repo topic)
+ (let ((value (string-trim (buffer-substring-no-properties
+ (point-min)
+ (point-max)))))
+ (oset topic note (if (equal value "") nil value)))
+ (delete-file buffer-file-name t)
+ (let ((dir (file-name-directory buffer-file-name)))
+ (unless (cddr (directory-files dir nil nil t))
+ (delete-directory dir)))
+ (let ((prevbuf forge--pre-post-buffer))
+ (magit-mode-bury-buffer 'kill)
+ (forge-refresh-buffer prevbuf)))
+
+;;; _
+(provide 'forge-post)
+;;; forge-post.el ends here
--- /dev/null
+;;; forge-pullreq.el --- Pullreq support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'forge)
+(require 'forge-post)
+(require 'forge-topic)
+
+;;; Classes
+
+(defclass forge-pullreq (forge-topic)
+ ((closql-table :initform 'pullreq)
+ (closql-primary-key :initform 'id)
+ (closql-order-by :initform [(desc number)])
+ (closql-foreign-key :initform 'repository)
+ (closql-class-prefix :initform "forge-")
+ (id :initarg :id)
+ (repository :initarg :repository)
+ (number :initarg :number)
+ (state :initarg :state)
+ (author :initarg :author)
+ (title :initarg :title)
+ (created :initarg :created)
+ (updated :initarg :updated :initform nil)
+ (closed :initarg :closed)
+ (merged :initarg :merged)
+ (status :initarg :status :initform nil)
+ (locked-p :initarg :locked-p)
+ (editable-p :initarg :editable-p)
+ (cross-repo-p :initarg :cross-repo-p)
+ (base-ref :initarg :base-ref)
+ (base-repo :initarg :base-repo)
+ (head-ref :initarg :head-ref)
+ (head-user :initarg :head-user)
+ (head-repo :initarg :head-repo)
+ (milestone :initarg :milestone)
+ (body :initarg :body)
+ (assignees :closql-tables (pullreq-assignee assignee))
+ (project-cards) ; projectsCards
+ (commits)
+ (edits) ; userContentEdits
+ (labels :closql-tables (pullreq-label label))
+ (participants)
+ (posts :closql-class forge-pullreq-post)
+ (reactions)
+ (review-requests :closql-tables (pullreq-review-request assignee))
+ (reviews)
+ (timeline)
+ (marks :closql-tables (pullreq-mark mark))
+ (note :initarg :note :initform nil)
+ (base-rev :initarg :base-rev)
+ (head-rev :initarg :head-rev)
+ (draft-p :initarg :draft-p)
+ (their-id :initarg :their-id)
+ (slug :initarg :slug)
+ (saved-p :initarg :saved-p :initform nil)
+ ))
+
+(cl-defmethod closql-dref ((obj forge-pullreq) (_(eql assignees)))
+ (forge-sql-cdr
+ [:select assignee:* :from assignee
+ :join pullreq-assignee :on (= pullreq-assignee:id assignee:id)
+ :where (= pullreq-assignee:pullreq $s1)
+ :order-by [(asc login)]]
+ (closql--oref obj 'id)))
+
+(cl-defmethod closql-dref ((obj forge-pullreq) (_(eql labels)))
+ (forge-sql-cdr
+ [:select label:* :from label
+ :join pullreq-label :on (= pullreq-label:id label:id)
+ :where (= pullreq-label:pullreq $s1)
+ :order-by [(asc name)]]
+ (closql--oref obj 'id)))
+
+(cl-defmethod closql-dref ((obj forge-pullreq) (_(eql review-requests)))
+ (forge-sql-cdr
+ [:select assignee:* :from assignee
+ :join pullreq-review-request :on (= pullreq-review-request:id assignee:id)
+ :where (= pullreq-review-request:pullreq $s1)
+ :order-by [(asc login)]]
+ (closql--oref obj 'id)))
+
+(cl-defmethod closql-dref ((obj forge-pullreq) (_(eql marks)))
+ (forge-sql-cdr
+ [:select mark:* :from mark
+ :join pullreq-mark :on (= pullreq-mark:id mark:id)
+ :where (= pullreq-mark:pullreq $s1)
+ :order-by [(asc name)]]
+ (closql--oref obj '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
+;;;; Get
+
+(cl-defmethod forge-get-repository ((post forge-pullreq-post))
+ (forge-get-repository (forge-get-pullreq post)))
+
+(cl-defmethod forge-get-topic ((post forge-pullreq-post))
+ (forge-get-pullreq post))
+
+(cl-defmethod forge-get-pullreq ((pullreq forge-pullreq))
+ pullreq)
+
+(cl-defmethod forge-get-pullreq ((repo forge-repository) number)
+ (closql-get (forge-db)
+ (forge--object-id 'forge-pullreq repo number)
+ 'forge-pullreq))
+
+(cl-defmethod forge-get-pullreq ((number integer))
+ (and-let* ((repo (forge-get-repository :tracked nil 'notatpt)))
+ (forge-get-pullreq repo number)))
+
+(cl-defmethod forge-get-pullreq ((id string))
+ (closql-get (forge-db) id 'forge-pullreq))
+
+(cl-defmethod forge-get-pullreq ((post forge-pullreq-post))
+ (closql-get (forge-db)
+ (oref post pullreq)
+ 'forge-pullreq))
+
+(cl-defmethod forge-get-pullreq ((_(eql :branch)) &optional branch)
+ (and-let* ((branch (or branch
+ (magit-section-case
+ (branch (oref it value))
+ (commit (magit--painted-branch-at-point)))))
+ (branch (cdr (magit-split-branch-name branch)))
+ (number (magit-get "branch" branch "pullRequest")))
+ (forge-get-pullreq (string-to-number number))))
+
+;;;; Current
+
+(defun forge-current-pullreq (&optional demand)
+ "Return the pull-request at point or being visited.
+If there is no such pull-request and DEMAND is non-nil, then signal
+an error."
+ (or (forge-pullreq-at-point)
+ (and (forge-pullreq-p forge-buffer-topic)
+ forge-buffer-topic)
+ (and demand (user-error "No current pull-request"))))
+
+(defun forge-pullreq-at-point (&optional demand)
+ "Return the pull-request at point.
+If there is no such pull-request and DEMAND is non-nil, then signal
+an error."
+ (or (thing-at-point 'forge-pullreq)
+ (magit-section-value-if 'pullreq)
+ (forge-get-pullreq :branch)
+ (and demand (user-error "No pull-request at point"))))
+
+(put 'forge-pullreq 'thing-at-point #'forge-thingatpt--pullreq)
+(defun forge-thingatpt--pullreq ()
+ (and-let* (((thing-at-point-looking-at "\\([#!]\\)\\([0-9]+\\)\\_>"))
+ (prefix (match-string-no-properties 1))
+ (number (string-to-number (match-string-no-properties 2)))
+ (repo (forge--repo-for-thingatpt))
+ ((or (equal prefix "#")
+ (forge-gitlab-repository--eieio-childp repo))))
+ (forge-get-pullreq repo number)))
+
+;;; Read
+
+(defun forge-read-pullreq (prompt)
+ "Read an active pull-request with completion using PROMPT.
+
+Open, unread and pending pull-requests are considered active.
+Default to the current pull-request, even if it isn't active.
+
+\\<forge-read-topic-minibuffer-map>While completion is in \
+progress, \\[forge-read-topic-lift-limit] lifts the limit, extending
+the completion candidates to include all pull-requests.
+
+If `forge-limit-topic-choices' is nil, then all candidates
+can be selected from the start."
+ (forge--read-topic prompt
+ #'forge-current-pullreq
+ (forge--topics-spec :type 'pullreq :active t)
+ (forge--topics-spec :type 'pullreq :active nil :state nil)))
+
+;;; Utilities
+
+(defun forge--pullreq-branch-internal (pullreq)
+ (let ((branch (oref pullreq head-ref)))
+ ;; It is invalid for a branch name to begin with a colon, yet
+ ;; that is what Gitlab uses when a pull-request's source branch
+ ;; has been deleted. On Github this is simply nil in the same
+ ;; situation.
+ (and branch (not (string-prefix-p ":" branch)) branch)))
+
+(defun forge--pullreq-branch-active (pullreq)
+ (let* ((number (number-to-string (oref pullreq number)))
+ (branch-n (format "pr-%s" number))
+ (branch (forge--pullreq-branch-internal pullreq)))
+ (or (and (magit-branch-p branch)
+ (equal (magit-get "branch" branch "pullRequest") number)
+ branch)
+ (and (magit-branch-p branch-n)
+ (equal (magit-get "branch" branch-n "pullRequest") number)
+ branch-n))))
+
+(defun forge--pullreq-ref (pullreq)
+ (let ((ref (format "refs/pullreqs/%s" (oref pullreq number))))
+ (and (magit-rev-verify ref) ref)))
+
+(defun forge--pullreq-range (pullreq &optional endpoints)
+ (and-let* ((head (forge--pullreq-ref pullreq)))
+ (concat (forge--get-remote) "/" (oref pullreq base-ref)
+ (if endpoints "..." "..")
+ head)))
+
+;;; Insert
+
+(defvar-keymap forge-pullreqs-section-map
+ :parent forge-common-map
+ "<remap> <magit-browse-thing>" #'forge-browse-pullreqs
+ "<remap> <magit-visit-thing>" #'forge-list-pullreqs
+ "<remap> <forge--list-menu>" #'forge-topics-menu
+ "<remap> <forge--item-menu>" #'forge-topic-menu
+ "C-c C-n" #'forge-create-pullreq)
+
+(defvar-keymap forge-pullreq-section-map
+ :parent forge-common-map
+ "<remap> <magit-visit-thing>" #'forge-visit-this-topic
+ "<remap> <forge--list-menu>" #'forge-topics-menu
+ "<remap> <forge--item-menu>" #'forge-topic-menu)
+
+(cl-defun forge-insert-pullreqs (&optional (spec nil sspec) heading)
+ "Insert a list of pull-requests, according to `forge--buffer-topics-spec'.
+Optional SPEC can be used to override that filtering specification,
+and optional HEADING to change the section heading."
+ (when-let (((forge-db t))
+ (repo (forge-get-repository :tracked?))
+ (spec (if sspec spec (forge--clone-buffer-topics-spec)))
+ ((memq (oref spec type) '(topic pullreq))))
+ (oset spec type 'pullreq)
+ (forge--insert-topics 'pullreqs
+ (or heading "Pull requests")
+ (forge--list-topics spec repo))))
+
+(defun forge--insert-pullreq-commits (pullreq &optional all)
+ (cl-letf (((symbol-function #'magit-cancel-section) (lambda ())))
+ (if all
+ ;; Numeric pr ref, pr branch (if it exists) and api
+ ;; pr range may be out of sync. Just show them all.
+ (magit-insert-section-body
+ (magit--insert-log nil
+ (delq nil (list (concat "^" (or (oref pullreq base-rev)
+ (concat (forge--get-remote) "/"
+ (oref pullreq base-ref))))
+ (forge--pullreq-ref pullreq)
+ (forge--pullreq-branch-active pullreq)
+ (and-let* ((branch (oref pullreq head-ref)))
+ (and (magit-local-branch-p branch) branch))))
+ (seq-uniq (cons "--graph" magit-buffer-log-args))))
+ (when-let ((range (forge--pullreq-range pullreq)))
+ (magit-insert-section-body
+ (magit--insert-log nil range magit-buffer-log-args)
+ (magit-make-margin-overlay nil t))))))
+
+;;; _
+(provide 'forge-pullreq)
+;;; forge-pullreq.el ends here
--- /dev/null
+;;; forge-repo.el --- Repository support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'forge)
+(require 'eieio)
+
+;;; Classes
+
+(defclass forge-repository (forge-object)
+ ((closql-class-prefix :initform "forge-")
+ (closql-class-suffix :initform "-repository")
+ (closql-table :initform 'repository)
+ (closql-primary-key :initform 'id)
+ (issues-url-format :initform nil :allocation :class)
+ (issue-url-format :initform nil :allocation :class)
+ (issue-post-url-format :initform nil :allocation :class)
+ (pullreqs-url-format :initform nil :allocation :class)
+ (pullreq-url-format :initform nil :allocation :class)
+ (pullreq-post-url-format :initform nil :allocation :class)
+ (commit-url-format :initform nil :allocation :class)
+ (branch-url-format :initform nil :allocation :class)
+ (remote-url-format :initform nil :allocation :class)
+ (create-issue-url-format :initform nil :allocation :class)
+ (create-pullreq-url-format :initform nil :allocation :class)
+ (pullreq-refspec :initform nil :allocation :class)
+ (id :initform nil :initarg :id)
+ (forge-id :initform nil :initarg :forge-id)
+ (forge :initform nil :initarg :forge)
+ (owner :initform nil :initarg :owner)
+ (name :initform nil :initarg :name)
+ (apihost :initform nil :initarg :apihost)
+ (githost :initform nil :initarg :githost)
+ (remote :initform nil :initarg :remote)
+ (condition :initform :stub)
+ (created :initform nil)
+ (updated :initform nil)
+ (pushed :initform nil)
+ (parent :initform nil)
+ (description :initform nil)
+ (homepage :initform nil)
+ (default-branch :initform nil)
+ (archived-p :initform nil)
+ (fork-p :initform nil)
+ (locked-p :initform nil)
+ (mirror-p :initform nil)
+ (private-p :initform nil)
+ (issues-p :initform t)
+ (wiki-p :initform nil)
+ (stars :initform nil)
+ (watchers :initform nil)
+ (assignees :closql-table assignee)
+ (forks :closql-table fork)
+ (issues :closql-class forge-issue)
+ (labels :closql-table label)
+ (pullreqs :closql-class forge-pullreq)
+ (revnotes :closql-class forge-revnote)
+ (selective-p :initform nil)
+ (worktree :initform nil)
+ (milestones :closql-table milestone)
+ (issues-until :initform nil)
+ (pullreqs-until :initform nil))
+ :abstract t)
+
+(defclass forge-unusedapi-repository (forge-repository) () :abstract t)
+
+(defclass forge-noapi-repository (forge-repository) () :abstract t)
+
+(cl-defmethod slot-missing ((object forge-repository)
+ slot-name operation &optional _new-value)
+ (if (and (eq operation 'oref)
+ (eq slot-name 'slug))
+ (concat (oref object owner) "/"
+ (oref object name))
+ (cl-call-next-method)))
+
+;;; Query
+;;;; Get
+
+(defvar-local forge-buffer-repository nil)
+(put 'forge-buffer-repository 'permanent-local t)
+
+(defvar-local forge-buffer-unassociated-p nil)
+
+(defconst forge--signal-no-entry '(:tracked :stub :insert!))
+
+(defun forge--get-remote (&optional warn ignore-variable)
+ (let* ((remotes (magit-list-remotes))
+ (config (and (not ignore-variable)
+ (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/How-Forge-Detection-Works.html"))
+ remote))
+
+(cl-defmethod forge-get-repository ((_(eql :id)) id)
+ (closql-get (forge-db) (substring-no-properties id) 'forge-repository))
+
+(cl-defmethod forge-get-repository ((_(eql :dir)) dir)
+ (let ((default-directory dir)
+ (forge-buffer-repository nil)
+ (forge-buffer-topic nil))
+ (forge-get-repository :stub? nil 'notatpt)))
+
+(cl-defmethod forge-get-repository ((demand symbol) &optional remote notatpt)
+ "Return the current forge repository.
+
+First check if `forge-buffer-repository', or if that is nil, then
+the repository for `forge-buffer-topic', satisfies DEMAND. If so,
+then return that repository.
+
+Otherwise return the repository for `default-directory', if that
+exists and satisfies DEMAND. If that fails too, then return nil
+or signal an error, depending on DEMAND."
+ (or (and-let* ((repo (and (not notatpt)
+ (forge-repository-at-point))))
+ (forge-get-repository repo 'noerror demand))
+ (and-let* ((repo (or (forge-buffer-repository)
+ (and forge-buffer-topic
+ (forge-get-repository forge-buffer-topic)))))
+ (forge-get-repository repo 'noerror demand))
+ (magit--with-refresh-cache
+ (list default-directory 'forge-get-repository demand)
+ (if (not (magit-gitdir))
+ (when (memq demand forge--signal-no-entry)
+ (error
+ "Cannot determine Forge repository outside of Git repository"))
+ (unless remote
+ (setq remote (forge--get-remote 'warn)))
+ (if-let ((url (and remote
+ (magit-git-string "remote" "get-url" remote))))
+ (and-let* ((repo (forge-get-repository url remote demand)))
+ (progn ; work around debbugs#31840
+ (oset repo worktree (magit-toplevel))
+ repo))
+ (when (memq demand forge--signal-no-entry)
+ (error
+ "Cannot determine forge repository. %s\nSee %s."
+ (cond (remote (format "No url configured for %S." remote))
+ ((and-let* ((config (magit-get "forge.remote")))
+ (format "Value of `forge.remote' is %S but %s"
+ config "that remote does not exist.")))
+ ((magit-list-remotes) "Cannot decide on remote to use.")
+ (t "No remote configured."))
+ "https://magit.vc/manual/forge/How-Forge-Detection-Works.html"
+ )))))))
+
+(cl-defmethod forge-get-repository ((url string) &optional remote demand)
+ "Return the repository at URL."
+ (if-let ((parts (forge--split-forge-url url)))
+ (forge-get-repository parts remote (or demand :known?))
+ (when (memq demand forge--signal-no-entry)
+ (error "Cannot determine forge repository. %s isn't a forge URL. %s"
+ url "You might have to customize `forge-alist'."))))
+
+(cl-defmethod forge-get-repository (((host owner name) list)
+ &optional remote demand)
+ "((HOST OWNER NAME) &optional REMOTE DEMAND)
+
+Return the repository identified by HOST, OWNER and NAME.
+See `forge-alist' for valid Git hosts."
+ (setq host (substring-no-properties host))
+ (setq owner (substring-no-properties owner))
+ (setq name (substring-no-properties name))
+ (unless (memq demand '( :tracked :tracked?
+ :known? :insert! :valid?
+ :stub :stub?))
+ (if-let ((new (pcase demand
+ ('t :tracked)
+ ('full :tracked?)
+ ('nil :known?)
+ ('create :insert!)
+ ('stub :stub)
+ ('maybe :stub?))))
+ (progn
+ (message "Obsolete value for `%s's DEMAND: `%s'; use `%s' instead"
+ 'forge-get-repository demand new)
+ (setq demand new))
+ (error "Unknown value for `%s's DEMAND: `%s'"
+ 'forge-get-repository demand)))
+ (if-let ((spec (forge--get-forge-host host t)))
+ (pcase-let ((`(,githost ,apihost ,webhost ,class) spec))
+ ;; The `webhost' is used to identify the corresponding forge.
+ ;; For that reason it is stored in the `forge' slot. The id
+ ;; stored in the `id' slot also derives from that value.
+ (let* ((row (car (forge-sql [:select * :from repository
+ :where (and (= forge $s1)
+ (= owner $s2)
+ (= name $s3))]
+ webhost owner name)))
+ (obj (and row (closql--remake-instance class (forge-db) row))))
+ ;; Synchronize the object with the entry from `forge-alist'.
+ ;; This only has an effect if the entry was modified, which
+ ;; should rarely, if ever, happen. Avoid confusion, by not
+ ;; mentioning this detail in any docstring.
+ (when obj
+ (oset obj apihost apihost)
+ (oset obj githost githost)
+ (oset obj remote remote))
+ (pcase (list demand (and obj (eq (oref obj condition) :tracked)))
+ (`(:tracked? nil) (setq obj nil))
+ (`(:tracked nil)
+ (error "Cannot use `%s' in %S yet.\n%s"
+ this-command (magit-toplevel)
+ "Use `M-x forge-add-repository' before trying again.")))
+ (when (and (memq demand '(:insert! :valid? :stub :stub?))
+ (not obj))
+ (pcase-let ((`(,id . ,forge-id)
+ (forge--repository-ids
+ class webhost owner name
+ (memq demand '(:stub :stub?))
+ (eq demand :valid?))))
+ (if (not id)
+ ;; `:valid?' was used and it turned out it is not.
+ (setq obj nil)
+ ;; The repo might have been renamed on the forge. #188
+ (unless (setq obj (forge-get-repository :id id))
+ (setq obj (funcall class
+ :id id
+ :forge-id forge-id
+ :forge webhost
+ :owner owner
+ :name name
+ :apihost apihost
+ :githost githost
+ :remote remote))
+ (when (eq demand :insert!)
+ (closql-insert (forge-db) obj)
+ (oset obj condition :known))))))
+ obj))
+ (when (memq demand forge--signal-no-entry)
+ (error "Cannot determine forge repository. No entry for %S in %s"
+ host 'forge-alist))))
+
+(cl-defmethod forge-get-repository ((repo forge-repository)
+ &optional noerror demand)
+ (setq noerror (and noerror t))
+ (with-slots (condition slug) repo
+ (cl-symbol-macrolet
+ ((err (error "Requested %s for %s, but is %s" demand slug condition))
+ (key (list (oref repo forge)
+ (oref repo owner)
+ (oref repo name)))
+ (ins (forge-get-repository key nil :insert!))
+ (set (forge-get-repository key nil :valid?)))
+ (pcase-exhaustive (list demand condition noerror)
+ (`(nil ,_ ,_) repo)
+ (`(:tracked? :tracked ,_) repo)
+ (`(:tracked? ,_ ,_) nil)
+ (`(:tracked :tracked ,_) repo)
+ (`(:tracked ,_ t) nil)
+ (`(:tracked ,_ nil) err)
+ (`(:known? ,(or :tracked :known) ,_) repo)
+ (`(:known? ,_ ,_) nil)
+ (`(:insert! ,(or :tracked :known) ,_) repo)
+ (`(:insert! ,_ ,_) ins)
+ (`(:valid? ,(or :tracked :known) ,_) repo)
+ (`(:valid? ,_ ,_) set)
+ (`(:stub? ,_ ,_) repo)
+ (`(:stub ,_ ,_) repo)))))
+
+(cl-defmethod forge-get-repository ((_ null) &optional noerror demand)
+ (if (and (memq demand '(:insert! :tracked :stub))
+ (not noerror))
+ (error "(Maybe repository) is nil; `%s' not satisfied" demand)
+ nil))
+
+(defun forge--get-repository:tracked? ()
+ (forge-get-repository :tracked?))
+
+(defun forge-repository-at-point (&optional demand)
+ "Return the repository at point.
+If there is no such repository and DEMAND is non-nil, then signal
+an error."
+ (or (magit-section-value-if 'forge-repo)
+ (and-let* ((topic (forge-topic-at-point)))
+ (forge-get-repository topic))
+ (and (derived-mode-p 'forge-repository-list-mode)
+ (and-let* ((id (tabulated-list-get-id)))
+ (forge-get-repository :id id)))
+ (and (derived-mode-p 'magit-repolist-mode)
+ (and-let* ((dir (tabulated-list-get-id)))
+ (forge-get-repository :dir dir)))
+ (and demand (user-error "No repository at point"))))
+
+(defun forge--repo-for-thingatpt ()
+ (or (magit-section-value-if 'forge-repo)
+ (and-let* ((topic (magit-section-value-if '(issue pullreq))))
+ (forge-get-repository topic))
+ (and (not forge-buffer-unassociated-p)
+ (or (forge-buffer-repository)
+ (forge-get-repository :known? nil 'notatpt)))))
+
+(defun forge-buffer-repository ()
+ (and-let* ((id forge-buffer-repository))
+ (forge-get-repository :id id)))
+
+(defun forge-set-buffer-repository ()
+ "Initialize the value of variable `forge-buffer-repository'."
+ (unless forge-buffer-repository
+ (and-let* ((repo (forge-get-repository :known?)))
+ (setq forge-buffer-repository (oref repo id)))))
+
+(add-hook 'magit-mode-hook #'forge-set-buffer-repository)
+
+(defun forge-get-worktree (repo)
+ "Validate, remember and return a worktree for REPO.
+If `default-directory' is within one of REPO's worktrees, record that
+location in its `worktree' slot and return it. Otherwise, if a worktree
+has been recorded before, validate that. If it still is a worktree of
+REPO, return it, else set the slot to nil and return nil."
+ (if-let (((forge-repository-equal
+ repo (forge-get-repository :dir default-directory)))
+ (current-tree (magit-toplevel)))
+ (oset repo worktree current-tree)
+ (and-let* ((saved-tree (oref repo worktree)))
+ (and (file-accessible-directory-p saved-tree)
+ (if (forge-repository-equal
+ repo (forge-get-repository :dir saved-tree))
+ saved-tree
+ (oset repo worktree nil))))))
+
+;;;; List
+
+(defun forge--ls-repos ()
+ (mapcar (let ((db (forge-db)))
+ (lambda (row)
+ (closql--remake-instance 'forge-repository db row)))
+ (forge-sql [:select * :from repository
+ :order-by [(asc owner) (asc name)]])))
+
+(defun forge--ls-owned-repos ()
+ (mapcar (let ((db (forge-db)))
+ (lambda (row)
+ (closql--remake-instance 'forge-repository db row)))
+ (forge-sql [:select * :from repository
+ :where (and (in owner $v1)
+ (not (in name $v2)))
+ :order-by [(asc owner) (asc name)]]
+ (vconcat (mapcar #'car forge-owned-accounts))
+ (vconcat forge-owned-ignored))))
+
+;;; Identity
+
+(defun forge-repository-equal (repo1 repo2)
+ "Return t if REPO1 and REPO2 are the same repository.
+REPO1 and/or REPO2 may also be nil, in which case return nil."
+ (and repo1 repo2
+ (or (equal (oref repo1 id) (oref repo2 id))
+ (and (equal (oref repo1 githost) (oref repo2 githost))
+ (equal (oref repo1 owner) (oref repo2 owner))
+ (equal (oref repo1 name) (oref repo2 name))))))
+
+(cl-defmethod forge--repository-ids ((class (subclass forge-repository))
+ host owner name &optional stub noerror)
+ "Return (OUR-ID . THEIR-ID) of the specified repository.
+If optional STUB is non-nil, then the IDs are not guaranteed to
+be unique. Otherwise this method has to make an API request to
+retrieve THEIR-ID, the repository's ID on the forge. In that
+case OUR-ID derives from THEIR-ID and is unique across all
+forges and hosts."
+ (pcase-let* ((`(,_githost ,apihost ,id ,_class)
+ (forge--get-forge-host host t))
+ (path (format "%s/%s" owner name))
+ (their-id (and (not stub)
+ (ghub-repository-id
+ owner name
+ :host apihost
+ :auth 'forge
+ :forge (forge--ghub-type-symbol class)
+ :noerror noerror))))
+ (and (or stub their-id (not noerror))
+ (cons (base64-encode-string
+ (format "%s:%s" id
+ (cond (stub path)
+ ((eq class 'forge-github-repository)
+ ;; This is base64 encoded, according to
+ ;; https://docs.github.com/en/graphql/
+ ;; reference/scalars#id. Unfortunately
+ ;; that is not always true. E.g.,
+ ;; https://github.com/dit7ya/roamex.
+ (condition-case nil
+ (base64-decode-string their-id)
+ (error their-id)))
+ (t their-id)))
+ t)
+ (or their-id path)))))
+
+(cl-defmethod forge--repository-ids ((_class (subclass forge-noapi-repository))
+ host owner name &optional _stub _noerror)
+ (let ((their-id (if owner (concat owner "/" name) name)))
+ (cons (base64-encode-string
+ (format "%s:%s"
+ (nth 3 (forge--get-forge-host host t))
+ their-id)
+ t)
+ their-id)))
+
+;;; Read
+
+(defun forge-read-repository (prompt)
+ (let ((choice (magit-completing-read
+ prompt
+ (mapcar (pcase-lambda (`(,host ,owner ,name))
+ (format "%s/%s @%s" owner name host))
+ (forge-sql [:select [githost owner name]
+ :from repository]))
+ nil t nil nil
+ (and-let* ((default (forge-get-repository :stub?)))
+ (format "%s/%s @%s"
+ (oref default owner)
+ (oref default name)
+ (oref default githost))))))
+ (save-match-data
+ (if (string-match "\\`\\(.+\\)/\\([^/]+\\) @\\(.+\\)\\'" choice)
+ (forge-get-repository (list (match-string 3 choice)
+ (match-string 1 choice)
+ (match-string 2 choice)))
+ (error "BUG")))))
+
+(defun forge-read-host (prompt &optional class)
+ (magit-completing-read
+ prompt
+ (if class
+ (seq-keep (pcase-lambda (`(,githost ,_apihost ,_webhost ,c))
+ (and (child-of-class-p c class) githost))
+ forge-alist)
+ (mapcar #'car forge-alist))
+ nil t))
+
+;;; Miscellaneous
+
+(defun forge--as-githost (host)
+ (or (car (car (cl-member host forge-alist :test #'equal :key #'car)))
+ (car (car (cl-member host forge-alist :test #'equal :key #'cadr)))
+ (car (car (cl-member host forge-alist :test #'equal :key #'caddr)))
+ (user-error "Cannot determine githost for %S" host)))
+
+(defun forge--as-apihost (host)
+ (or (cadr (car (cl-member host forge-alist :test #'equal :key #'cadr)))
+ (cadr (car (cl-member host forge-alist :test #'equal :key #'car)))
+ (cadr (car (cl-member host forge-alist :test #'equal :key #'caddr)))
+ (user-error "Cannot determine apihost for %S" host)))
+
+(cl-defmethod forge--format ((repo forge-repository) format-or-slot &optional spec)
+ (pcase-let* (((eieio (forge webhost) owner name) repo)
+ (path (if owner (concat owner "/" name) name)))
+ (format-spec
+ (let ((format (if (symbolp format-or-slot)
+ (eieio-oref repo format-or-slot)
+ format-or-slot)))
+ (if (member webhost ghub-insecure-hosts)
+ (replace-regexp-in-string "\\`https://" "http://" format t t)
+ format))
+ `(,@spec
+ (?h . ,webhost)
+ (?o . ,owner)
+ (?n . ,name)
+ (?p . ,path)
+ (?P . ,(string-replace "/" "%2F" path))))))
+
+(defun forge--set-field-callback (topic)
+ (lambda (&rest _)
+ (forge--pull-topic
+ (forge-get-repository topic)
+ topic
+ :callback (lambda ()
+ (forge-refresh-buffer)
+ (when (transient-active-prefix
+ '(forge-topic-menu
+ forge-topics-menu
+ forge-notifications-menu))
+ (transient--refresh-transient))))))
+
+(defvar forge--mode-line-buffer nil)
+
+(defun forge--msg (repo echo done format &rest args)
+ (let ((msg (apply #'format format args)))
+ (when repo
+ (setq msg (string-replace
+ "REPO"
+ (concat (oref repo owner) "/" (oref repo name))
+ msg)))
+ (when (and echo msg)
+ (message "%s%s" msg (if done "...done" "...")))
+ (when (buffer-live-p forge--mode-line-buffer)
+ (with-current-buffer forge--mode-line-buffer
+ (setq mode-line-process
+ (if done
+ nil
+ (concat " " (propertize msg 'font-lock-face
+ 'magit-mode-line-process)))))
+ (force-mode-line-update t))))
+
+(cl-defmethod ghub--host ((repo forge-repository))
+ (cl-call-next-method (forge--ghub-type-symbol (eieio-object-class repo))))
+
+(cl-defmethod ghub--username ((repo forge-repository))
+ (let ((default-directory default-directory))
+ (unless (forge-repository-equal (forge-get-repository :stub?) repo)
+ (when-let ((worktree (forge-get-worktree repo)))
+ (setq default-directory worktree)))
+ (cl-call-next-method (oref repo apihost)
+ (forge--ghub-type-symbol (eieio-object-class repo)))))
+
+(defun forge--ghub-type-symbol (class)
+ (pcase-exhaustive class
+ ;; This package does not define a `forge-gitlab-http-repository'
+ ;; class, but we used to suggest at #9 that users define such a class
+ ;; if they must connect to a Gitlab instance that uses http instead
+ ;; of https. Doing that isn't necessary anymore, but we have to keep
+ ;; supporting it here. It is now sufficient to add an entry to
+ ;; `ghub-insecure-hosts'.
+ ((or 'forge-gitlab-repository 'forge-gitlab-http-repository) 'gitlab)
+ ('forge-github-repository 'github)
+ ('forge-gitea-repository 'gitea)
+ ('forge-gogs-repository 'gogs)
+ ('forge-bitbucket-repository 'bitbucket)))
+
+;;; _
+(provide 'forge-repo)
+;;; forge-repo.el ends here
--- /dev/null
+;;; forge-repos.el --- List repositories -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'hl-line)
+
+(require 'forge-repo)
+(require 'forge-tablist)
+
+(defvar x-stretch-cursor)
+
+;;; Options
+
+(defcustom forge-repository-list-mode-hook '(hl-line-mode)
+ "Hook run after entering Forge-Repository-List mode."
+ :package-version '(forge . "0.4.0")
+ :group 'forge
+ :type 'hook
+ :options '(hl-line-mode))
+
+(defcustom forge-repository-list-columns
+ '(("Owner" owner 20 t nil)
+ ("Name" name 20 t nil)
+ ("T" forge-format-repo-condition 1 t nil)
+ ("S" forge-format-repo-selective 1 t nil)
+ ("Worktree" worktree 99 t nil))
+ "List of columns displayed when listing repositories.
+
+Each element has the form (HEADER SOURCE WIDTH SORT PROPS).
+
+HEADER is the string displayed in the header. WIDTH is the width
+of the column. SOURCE is used to get the value, it has to be the
+name of a slot of `forge-repository' or a function that takes
+such an object as argument. SORT is a boolean or a function used
+to sort by this column. Supported PROPS include `:right-align'
+and `:pad-right'."
+ :package-version '(forge . "0.4.0")
+ :group 'forge
+ :type forge--tablist-columns-type)
+
+;;; Mode
+
+(defvar-keymap forge-repository-list-mode-map
+ :doc "Local keymap for Forge-Repository-List mode buffers."
+ :parent (make-composed-keymap forge-common-map tabulated-list-mode-map)
+ "n" #'forge-dispatch
+ "RET" #'forge-visit-this-repository
+ "<return>" #'forge-visit-this-repository
+ "o" #'forge-browse-this-repository
+ "<remap> <forge--list-menu>" #'forge-repositories-menu)
+
+(defvar-local forge--buffer-list-filter nil)
+
+(defvar forge-repository-list-buffer-name "*forge-repositories*"
+ "Buffer name to use for displaying lists of repositories.")
+
+(defvar forge-repository-list-mode-name
+ '((:eval (capitalize
+ (concat (if forge--buffer-list-filter
+ (format "%s " forge--buffer-list-filter)
+ "")
+ "repositories"))))
+ "Information shown in the mode-line for `forge-repository-list-mode'.
+Must be set before `forge-list' is loaded.")
+
+(define-derived-mode forge-repository-list-mode tabulated-list-mode
+ forge-repository-list-mode-name
+ "Major mode for browsing a list of repositories."
+ :interactive nil
+ (setq-local x-stretch-cursor nil)
+ (setq tabulated-list-padding 0)
+ (setq tabulated-list-sort-key (cons "Owner" nil)))
+
+(defun forge-repository-list-setup (filter fn)
+ (let ((buffer (get-buffer-create forge-repository-list-buffer-name)))
+ (with-current-buffer buffer
+ (setq default-directory "/")
+ (setq forge--tabulated-list-columns forge-repository-list-columns)
+ (setq forge--tabulated-list-query fn)
+ (cl-letf (((symbol-function #'tabulated-list-revert) #'ignore)) ; see #229
+ (forge-repository-list-mode))
+ (setq forge--buffer-list-filter filter)
+ (forge--tablist-refresh)
+ (add-hook 'tabulated-list-revert-hook #'forge--tablist-refresh nil t)
+ (tabulated-list-print)
+ (when hl-line-mode
+ (hl-line-highlight)))
+ (switch-to-buffer buffer)))
+
+(defun forge-format-repo-condition (repo)
+ "Return a character representing the value of REPO's `condition' slot."
+ (pcase-exhaustive (oref repo condition)
+ (:tracked "*")
+ (:known " ")
+ (:stub (propertize "s" 'face 'warning))))
+
+(defun forge-format-repo-selective (repo)
+ "Return a character representing the value of REPO's `selective-p' slot."
+ (pcase-exhaustive (oref repo selective-p)
+ ('t "*")
+ ('nil " ")))
+
+;;; Commands
+;;;; Menu
+
+;;;###autoload(autoload 'forge-repositories-menu "forge-repos" nil t)
+(transient-define-prefix forge-repositories-menu ()
+ "Control list of repositories displayed in the current buffer."
+ :transient-suffix t
+ :transient-non-suffix #'transient--do-call
+ :transient-switch-frame nil
+ :refresh-suffixes t
+ :environment #'forge--menu-environment
+ :column-widths forge--topic-menus-column-widths
+ [:hide always ("q" forge-menu-quit-list)]
+ [forge--topic-menus-group
+ forge--lists-group
+ ["Filter"
+ ("o" "owned" forge-list-owned-repositories
+ :if-nil forge--buffer-list-filter)
+ ("o" "owned" forge-list-repositories
+ :face forge-suffix-active
+ :if-non-nil forge--buffer-list-filter
+ :inapt-if-mode nil)]]
+ (interactive)
+ (unless (derived-mode-p 'forge-repository-list-mode)
+ (if-let ((buffer (get-buffer forge-repository-list-buffer-name)))
+ (switch-to-buffer buffer)
+ (forge-list-repositories)))
+ (transient-setup 'forge-repositories-menu))
+
+(transient-augment-suffix forge-repositories-menu
+ :transient #'transient--do-replace
+ :if-mode 'forge-repository-list-mode
+ :inapt-if (lambda () (eq (oref transient--prefix command) 'forge-repositories-menu))
+ :inapt-face 'forge-suffix-active)
+
+;;;; List
+
+(defclass forge--repo-list-command (transient-suffix)
+ ((type :initarg :type :initform nil)
+ (filter :initarg :filter :initform nil)
+ (global :initarg :global :initform nil)))
+
+;;;###autoload(autoload 'forge-list-repositories "forge-repos" nil t)
+(transient-define-suffix forge-list-repositories ()
+ "List known repositories in a separate buffer.
+Here \"known\" means that an entry exists in the local database."
+ :class 'forge--repo-list-command :type 'repo :global t
+ :inapt-if-mode 'forge-repository-list-mode
+ :inapt-face 'forge-suffix-active
+ (declare (interactive-only nil))
+ (interactive)
+ (forge-repository-list-setup nil #'forge--ls-repos)
+ (transient-setup 'forge-repositories-menu))
+
+;;;###autoload(autoload 'forge-list-owned-repositories "forge-repos" nil t)
+(transient-define-suffix forge-list-owned-repositories ()
+ "List your own known repositories in a separate buffer.
+Here \"known\" means that an entry exists in the local database
+and options `forge-owned-accounts' and `forge-owned-ignored'
+controls which repositories are considered to be owned by you.
+Only Github is supported for now."
+ :class 'forge--repo-list-command :type 'repo :filter 'owned :global t
+ (interactive)
+ (forge-repository-list-setup 'owned #'forge--ls-owned-repos)
+ (transient-setup 'forge-repositories-menu))
+
+;;; _
+(provide 'forge-repos)
+;;; forge-repos.el ends here
--- /dev/null
+;;; forge-revnote.el --- Revnote support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'forge)
+(require 'forge-post)
+(require 'forge-topic)
+
+;;; Class
+
+(defclass forge-revnote (forge-topic)
+ ((closql-table :initform 'revnote)
+ (closql-primary-key :initform 'id)
+ ;; (closql-order-by :initform [(desc number)])
+ (closql-foreign-key :initform 'repository)
+ (closql-class-prefix :initform "forge-")
+ (id :initarg :id)
+ (repository :initarg :repository)
+ (commit :initarg :commit)
+ (file :initarg :file)
+ (line :initarg :line)
+ (author :initarg :author)
+ (body :initarg :body)))
+
+;;; _
+(provide 'forge-revnote)
+;;; forge-revnote.el ends here
--- /dev/null
+;;; forge-semi.el --- Support for semi-forges -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'forge)
+
+;;; Classes
+
+(defclass forge-gitweb-repository (forge-noapi-repository)
+ ((commit-url-format :initform "https://%h/gitweb/?p=%P.git;a=commitdiff;h=%r")
+ (branch-url-format :initform "https://%h/gitweb/?p=%P.git;a=log;h=refs/heads/%r")
+ (remote-url-format :initform "https://%h/gitweb/?p=%P.git;a=summary"))
+ "Gitweb from https://git-scm.com/docs/gitweb.")
+
+(defclass forge-cgit-repository (forge-noapi-repository)
+ ((commit-url-format :initform "https://%h/%p.git/commit/?id=%r")
+ (branch-url-format :initform "https://%h/%p.git/log/?h=%r")
+ (remote-url-format :initform "https://%h/%p.git/about"))
+ "Cgit from https://git.zx2c4.com/cgit/about.
+Different hosts use different url schemata, so we need multiple
+classes. See their definitions in \"forge-semi.el\".")
+
+(defclass forge-cgit*-repository (forge-cgit-repository)
+ ((commit-url-format :initform "https://%h/cgit/%p.git/commit/?id=%r")
+ (branch-url-format :initform "https://%h/cgit/%p.git/log/?h=%r")
+ (remote-url-format :initform "https://%h/cgit/%p.git/about"))
+ "Cgit from https://git.zx2c4.com/cgit/about.
+Different hosts use different url schemata, so we need multiple
+classes. See their definitions in \"forge-semi.el\".")
+
+(defclass forge-cgit**-repository (forge-cgit-repository)
+ ((commit-url-format :initform "https://%h/cgit/%n.git/commit/?id=%r")
+ (branch-url-format :initform "https://%h/cgit/%n.git/log/?h=%r")
+ (remote-url-format :initform "https://%h/cgit/%n.git/about"))
+ "Cgit from https://git.zx2c4.com/cgit/about.
+Different hosts use different url schemata, so we need multiple
+classes. See their definitions in \"forge-semi.el\".")
+
+(defclass forge-repoorcz-repository (forge-cgit-repository)
+ ((commit-url-format :initform "https://%h/%p.git/commit/%r")
+ (branch-url-format :initform "https://%h/%p.git/log/%r")
+ (remote-url-format :initform "https://%h/%p.git"))
+ "Cgit fork used on https://repo.or.cz/cgit.git.
+Different hosts use different url schemata, so we need multiple
+classes. See their definitions in \"forge-semi.el\".")
+
+(defclass forge-stagit-repository (forge-noapi-repository)
+ ((commit-url-format :initform "https://%h/%n/commit/%r.html")
+ (branch-url-format :initform "https://%h/%n/refs.html")
+ (remote-url-format :initform "https://%h/%n/file/README.html"))
+ "Stagit from https://codemadness.org/git/stagit/file/README.html.
+Only the history of \"master\" can be shown, so this links to the
+list of refs instead of the log of the specified branch.")
+
+(defclass forge-srht-repository (forge-noapi-repository)
+ ((commit-url-format :initform "https://%h/~%o/%n/commit/%r")
+ (branch-url-format :initform "https://%h/~%o/%n/log/%r")
+ (remote-url-format :initform "https://%h/~%o/%n"))
+ "See https://meta.sr.ht.")
+
+;;; _
+(provide 'forge-semi)
+;;; forge-semi.el ends here
--- /dev/null
+;;; forge-tablist.el --- Tabulated-list interface -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'tabulated-list)
+
+(require 'forge)
+
+(defconst forge--tablist-columns-type
+ '(repeat
+ (list :tag "Column"
+ (string :tag "Header Label")
+ (choice :tag "Value source"
+ function
+ (symbol :tag "Object slot"))
+ (integer :tag "Column Width")
+ (choice :tag "Sort predicate"
+ (const :tag "Don't sort" nil)
+ (const :tag "Default" t)
+ function)
+ (plist :tag "Properties"
+ :key-type (choice :tag "Property"
+ (const :right-align)
+ (const :pad-right)
+ symbol)
+ :value-type (sexp :tag "Value")))))
+
+(defvar-local forge--tabulated-list-columns nil)
+(put 'forge--tabulated-list-columns 'permanent-local t)
+
+(defvar-local forge--tabulated-list-query nil)
+(put 'forge--tabulated-list-query 'permanent-local t)
+
+(defun forge--tablist-refresh ()
+ (setq tabulated-list-format
+ (vconcat (mapcar (pcase-lambda (`(,name ,_get ,width ,sort ,props))
+ `(,name ,width ,sort . ,props))
+ forge--tabulated-list-columns)))
+ (tabulated-list-init-header)
+ (setq tabulated-list-entries
+ (mapcar
+ (lambda (obj)
+ (list (oref obj id)
+ (vconcat
+ (mapcar (pcase-lambda (`(,_name ,get ,_width ,_sort ,_props))
+ (let ((val (cond
+ ((functionp get)
+ (funcall get obj))
+ ((eq (car-safe get) 'repository)
+ (eieio-oref (forge-get-repository obj)
+ (cadr get)))
+ ((eieio-oref obj get)))))
+ (cond ((stringp val) val)
+ ((null val) "")
+ ((format "%s" val)))))
+ forge--tabulated-list-columns))))
+ (funcall forge--tabulated-list-query))))
+
+;;; _
+(provide 'forge-tablist)
+;;; forge-tablist.el ends here
--- /dev/null
+;;; forge-topic.el --- Topics support -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'bug-reference)
+(require 'eieio-custom)
+(require 'markdown-mode)
+(require 'parse-time)
+(require 'yaml)
+
+(require 'forge)
+(require 'forge-post)
+
+(defvar bug-reference-auto-setup-functions)
+
+;;; Options
+
+(defcustom forge-limit-topic-choices t
+ "Whether to initially limit completion candidates to active topics."
+ :package-version '(forge . "0.4.0")
+ :group 'forge
+ :type 'boolean)
+
+(defcustom forge-post-heading-format "%a %C\n"
+ "Format for post headings in topic view.
+
+The following %-sequences are supported:
+
+`%a' The forge nickname of the author.
+`%c' The absolute creation date.
+`%C' The relative creation date."
+ :package-version '(forge . "0.1.0")
+ :group 'forge
+ :type 'string)
+
+(defcustom forge-post-fill-region t
+ "Whether to call `fill-region' before displaying forge posts."
+ :package-version '(forge . "0.1.0")
+ :group 'forge
+ :type 'boolean)
+
+(defcustom forge-topic-repository-slug-width 28
+ "Width of repository slugs (i.e., \"OWNER/NAME\")."
+ :package-version '(forge . "0.4.0")
+ :group 'forge
+ :type 'natnum)
+
+(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 forge-format-avatar-function nil
+ "Function used to insert avatars in certain locations.
+This is experimental and intended for users who wish to
+implement such a function themselves. See #447.")
+
+;;; Faces
+;;;; Common
+
+(defface forge-dimmed '((t :foreground "#93a1a1"))
+ "Parent face or faces used for text that shouldn't stand out.
+
+This face is not directly, instead several faces inherit from it
+either directly or via an intermediate face. This face should
+only specify the `:foreground' attribute, which is why this face
+does not inherit from `magit-dimmed'."
+ :group 'forge-faces)
+
+(defface forge-topic-header-line
+ '((t :inherit magit-header-line :foreground reset))
+ "Face for the `header-line' in `forge-topic-mode' buffers."
+ :group 'forge-faces)
+
+;;;; Topic and Notification Slugs
+
+(defface forge-topic-slug-open
+ '((t :inherit forge-dimmed))
+ "Face uses for slugs of open topics."
+ :group 'forge-faces)
+
+(defface forge-topic-slug-completed
+ '((t :inherit forge-dimmed))
+ "Face used for slugs of completed topics."
+ :group 'forge-faces)
+
+(defface forge-topic-slug-unplanned
+ '((t :inherit forge-dimmed :strike-through t))
+ "Face used for slugs of unplanned topics.
+E.g., for issues closes as \"unplanned\" and pull-requests that
+were closed without being merged."
+ :group 'forge-faces)
+
+(defface forge-topic-slug-saved
+ '((t :foreground "orange"))
+ "Face used for slugs of topics with saved notifications."
+ :group 'forge-faces)
+
+(defface forge-topic-slug-unread
+ '((t :weight bold))
+ "Face used for slugs of topics with unread notifications."
+ :group 'forge-faces)
+
+;;;; Topic and Notification Summaries
+;;;;; Notifications
+
+(defface forge-topic-unread
+ '((t :weight bold
+ :box (:line-width (-1 . -1) :style nil)))
+ "Face used for summaries of entities with unread notifications.
+This face is always used together with, and takes preference over,
+a `forge-{issue,pullreq}-STATE' face and should not specify any
+attribute that is specified by any of those faces. Likewise those
+faces should not set `:weight' or `:slant'."
+ :group 'forge-faces)
+
+(defface forge-topic-pending
+ '((t :weight bold))
+ "Face used for summaries of entities with open notifications.
+This face is always used together with, and takes preference over,
+a `forge-{issue,pullreq}-STATE' face and should not specify any
+attribute that is specified by any of those faces. Likewise those
+faces should not set `:weight' or `:slant'."
+ :group 'forge-faces)
+
+(defface forge-topic-done
+ '((t))
+ "Face used for summaries of entities with no unread or open notification.
+This face is always used together with, and takes preference over,
+a `forge-{issue,pullreq}-STATE' face and should not specify any
+attribute that is specified by any of those faces. Likewise those
+faces should not set `:weight' or `:slant'."
+ :group 'forge-faces)
+
+;;;;; Issues
+
+(defface forge-issue-open
+ '((t))
+ "Face used for summaries of open issues."
+ :group 'forge-faces)
+
+(defface forge-issue-completed
+ '((t :inherit forge-dimmed))
+ "Face used for summaries of issues closed as completed."
+ :group 'forge-faces)
+
+(defface forge-issue-unplanned
+ '((t :inherit forge-dimmed :strike-through t))
+ "Face used for summaries of issues closed as unplanned."
+ :group 'forge-faces)
+
+;;;;; Pull-Requests
+
+(defface forge-pullreq-open
+ '((t :foreground "LimeGreen"))
+ "Face used for summaries of open pull-requests."
+ :group 'forge-faces)
+
+(defface forge-pullreq-merged
+ '((t :foreground "MediumPurple"))
+ "Face used for summaries of merged pull-requests."
+ :group 'forge-faces)
+
+(defface forge-pullreq-rejected
+ '((t :foreground "MediumPurple" :strike-through t))
+ "Face used for summaries of closed pull-requests, that weren't merged."
+ :group 'forge-faces)
+
+(defface forge-pullreq-draft
+ '((t :slant italic))
+ "Face used for summaries of draft pull-requests.
+A face attribute should be used that is not already used by any
+`forge-topic-STATUS' or `forge-{issue,pullreq}-STATE' face."
+ :group 'forge-faces)
+
+;;;; Labels
+
+(defface forge-topic-label
+ '((t :inherit secondary-selection
+ :box (:line-width (-1 . -1) :style released-button)))
+ "Face used for topic labels, marks and milestones."
+ :group 'forge-faces)
+
+;;;; Post Details
+
+(defface forge-post-author
+ '((t :inherit bold))
+ "Face used for post author in topic view."
+ :group 'forge-faces)
+
+(defface forge-post-date
+ '((t :inherit italic))
+ "Face used for post date in topic view."
+ :group 'forge-faces)
+
+;;; Class
+
+(defclass forge-topic (forge-post) () :abstract t)
+
+(cl-defmethod forge--object-id ((class (subclass forge-topic)) repo number)
+ "Return the id for a CLASS object in REPO identified by id NUMBER."
+ (base64-encode-string
+ (encode-coding-string
+ (format "%s:%s%s"
+ (base64-decode-string (oref repo id))
+ (substring (symbol-name class)
+ (length (oref-default class closql-class-prefix)))
+ number)
+ 'utf-8)
+ t))
+
+(cl-defmethod forge--object-id ((prefix string) number-or-id)
+ (base64-encode-string
+ (encode-coding-string
+ (format "%s:%s"
+ (base64-decode-string prefix)
+ (if (numberp number-or-id)
+ number-or-id
+ ;; Currently every ID is base64 encoded. Unfortunately
+ ;; we cannot use the IDs of Gitlab labels (see comment
+ ;; in the respective `forge--update-labels' method),
+ ;; and have to use their names, which are not encoded.
+ (or (ignore-errors (base64-decode-string number-or-id))
+ number-or-id)))
+ 'utf-8)
+ t))
+
+(cl-defmethod forge-topic-mark-read ((topic forge-topic))
+ (when (eq (oref topic status) 'unread)
+ (oset topic status 'pending)))
+
+(cl-defmethod forge--set-topic-marks ((_repo forge-repository) topic marks)
+ (oset topic marks
+ (mapcar #'car (forge-sql [:select id :from mark :where (in name $v1)]
+ (vconcat marks))))
+ (forge-refresh-buffer))
+
+;;; Query
+;;;; Get
+
+(cl-defmethod forge-get-parent ((topic forge-topic))
+ (forge-get-repository topic))
+
+(cl-defmethod forge-get-repository ((topic forge-topic))
+ (closql-get (forge-db)
+ (oref topic repository)
+ 'forge-repository))
+
+(cl-defmethod forge-get-topic ((topic forge-topic))
+ topic)
+
+(cl-defmethod forge-get-topic ((repo forge-repository) number-or-id)
+ (if (numberp number-or-id)
+ (if (< number-or-id 0)
+ (forge-get-pullreq repo (abs number-or-id))
+ (or (forge-get-issue repo number-or-id)
+ (forge-get-pullreq repo number-or-id)))
+ (or (forge-get-issue number-or-id)
+ (forge-get-pullreq number-or-id))))
+
+(cl-defmethod forge-get-topic ((number integer))
+ (if (< number 0)
+ (forge-get-pullreq (abs number))
+ (or (forge-get-issue number)
+ (forge-get-pullreq number))))
+
+(cl-defmethod forge-get-topic ((id string))
+ (or (forge-get-issue id)
+ (forge-get-pullreq id)))
+
+;;;; Current
+
+(defun forge-current-topic (&optional demand)
+ "Return the topic at point or being visited.
+If there is no such topic and DEMAND is non-nil, then signal
+an error."
+ (or (forge-topic-at-point)
+ forge-buffer-topic
+ (and demand (user-error "No current topic"))))
+
+(defun forge-topic-at-point (&optional demand)
+ "Return the topic at point.
+If there is no such topic and DEMAND is non-nil, then signal
+an error."
+ (or (thing-at-point 'forge-topic)
+ (magit-section-value-if '(issue pullreq))
+ (forge-get-pullreq :branch)
+ (and demand (user-error "No topic at point"))))
+
+(put 'forge-topic 'thing-at-point #'forge-thingatpt--topic)
+(defun forge-thingatpt--topic ()
+ (and-let* (((thing-at-point-looking-at "\\([#!]\\)\\([0-9]+\\)\\_>"))
+ (prefix (match-string-no-properties 1))
+ (number (string-to-number (match-string-no-properties 2)))
+ (repo (forge--repo-for-thingatpt)))
+ (cond ((equal prefix "#")
+ (forge-get-topic repo number))
+ ((forge-gitlab-repository--eieio-childp repo)
+ (forge-get-pullreq repo number)))))
+
+(defun forge-region-topics ()
+ (magit-region-values '(issue pullreq)))
+
+;;;; List
+
+(defvar-local forge--buffer-topics-spec nil)
+(put 'forge--buffer-topics-spec 'permanent-local t)
+
+(defun forge--init-buffer-topics-spec ()
+ (unless forge--buffer-topics-spec
+ (setq forge--buffer-topics-spec
+ (clone forge-status-buffer-default-topic-filters))))
+(add-hook 'magit-status-mode-hook #'forge--init-buffer-topics-spec)
+
+(defun forge--clone-buffer-topics-spec ()
+ (forge--init-buffer-topics-spec)
+ (clone forge--buffer-topics-spec))
+
+(defclass forge--topics-spec ()
+ ((type :documentation "\
+Limit list based on topic type."
+ :initarg :type
+ :initform 'topic
+ :type (member topic issue pullreq nil)
+ :custom (choice
+ (const topic)
+ (const issue)
+ (const pullreq)
+ (const :tag "disable topic sections (nil)" nil)))
+ (active :documentation "\
+Limit list to active topics.
+
+A topic is \"active\" if its state (public condition) is open and/or
+its status (private condition) is unread or pending.
+
+When this is t, then the value of the `state' and `status' slots are
+ignored."
+ :initarg :active
+ :initform t
+ :type boolean
+ :custom boolean)
+ (state :documentation "\
+Limit list based on topic (public) state.
+
+State is the \"public condition\". I.e., is the topic still open?"
+ :initarg :state
+ :initform 'open
+ :type (satisfies (lambda (val)
+ (member val '(open
+ (completed merged)
+ (unplanned rejected)
+ nil))))
+ :custom (choice
+ (const open)
+ (const (completed merged))
+ (const (unplanned rejected))
+ (const :tag "all (nil)" nil)))
+ (status :documentation "\
+Limit list based on topic (private) status.
+
+Status is the \"private condition\". I.e., have you decided yet
+that *you* are done with the topic, and have others made changes,
+which *you* have not seen yet?
+
+`inbox' means \"`unread' or `pending'\"."
+ :initarg :status
+ :initform nil
+ :type (member inbox unread pending done nil)
+ :custom (choice
+ (const inbox)
+ (const unread)
+ (const pending)
+ (const done)
+ (const :tag "all (nil)" nil)))
+ (updated :documentation "\
+Date when topic was last updated."
+ :initarg :updated
+ :initform nil
+ :type (or string null))
+ (milestone :documentation "\
+Limit list to topics assigned to given milestone."
+ :initarg :milestone
+ :initform nil
+ :type (or string null)
+ :custom string)
+ (labels :documentation "\
+Limit list to topics with at least one of the given labels."
+ :initarg :labels
+ :initform nil
+ :type (list-of string)
+ :custom (repeat string))
+ (marks :documentation "\
+Limit list to topics with at least one of the given marks.
+Marks are like labels, but they are private and local to the
+current Forge database."
+ :initarg :marks
+ :initform nil
+ :type (list-of string)
+ :custom (repeat string))
+ (saved :documentation "Limit list to saved topics."
+ :initarg :saved
+ :initform nil
+ :type boolean
+ :custom boolean)
+ (author :documentation "\
+Limit list to topics created by given user."
+ :initarg :author
+ :initform nil
+ :label "Author (username)"
+ :type (or string null)
+ :custom string)
+ (assignee :documentation "\
+Limit list to topics assigned to given user."
+ :initarg :assignee
+ :initform nil
+ :label "Assignee (username)"
+ :type (or string null)
+ :custom string)
+ (reviewer :documentation "\
+Limit list to topics for which a review by the given user was requested."
+ :initarg :reviewer
+ :initform nil
+ :label "Reviewer (username)"
+ :type (or string null)
+ :custom string)
+ (global :documentation "Whether to list topics for all repositories."
+ :initarg :global
+ :initform nil
+ :type boolean)
+ (order :documentation "Order in which topics are listed."
+ :initarg :order
+ :initform 'newest
+ :type (member newest oldest recently-updated anciently-updated)
+ :custom (choice (const newest)
+ (const oldest)
+ (const recently-updated)
+ (const anciently-updated)))
+ (limit :documentation "Number of topics to list at most."
+ :initarg :limit
+ :initform 200
+ :type integer
+ :custom natnum)
+ (grouped :documentation "Whether to group topics by repository."
+ :initarg :grouped
+ :initform nil
+ :type boolean
+ :custom boolean)))
+
+(cl-defun forge--list-topics
+ (&optional (spec forge--buffer-topics-spec)
+ (repo (forge-get-repository :tracked?))
+ (type (oref spec type)))
+ (when (oref spec reviewer)
+ (setq type 'pullreq))
+ (if (eq type 'topic)
+ (pcase-let ((`(,pred ,slot) (pcase (oref spec order)
+ ('newest '(> number))
+ ('oldest '(< number))
+ ('recently-updated '(> updated))
+ ('anciently-updated '(< updated)))))
+ (cl-sort (nconc (forge--list-topics-1 spec repo 'issue)
+ (forge--list-topics-1 spec repo 'pullreq))
+ pred :key (lambda (obj) (eieio-oref obj slot))))
+ (forge--list-topics-1 spec repo type)))
+
+(defun forge--list-topics-1 (spec repo type)
+ (mapcar (apply-partially #'closql--remake-instance
+ (if (eq type 'issue) 'forge-issue 'forge-pullreq)
+ (forge-db))
+ (forge-sql (forge--list-topics-2 spec repo type))))
+
+(defun forge--list-topics-2 (spec repo type)
+ (pcase-let (((eieio active state status milestone labels marks
+ saved author assignee reviewer global order limit)
+ spec))
+ (cond (active
+ (setq state 'open)
+ (setq status '(unread pending)))
+ ((eq status 'inbox)
+ (setq status '(unread pending))))
+ `[:select :distinct topic:*
+ :from [(as ,type topic)]
+ ,@(cond
+ (milestone
+ `[:join milestone :on (= milestone:title ,milestone)]))
+ ,@(cond
+ ((not labels) nil)
+ ((eq type 'issue)
+ [:join issue-label :on (= issue-label:issue topic:id)
+ :join label :on (= label:id issue-label:id)])
+ ([:join pullreq-label :on (= pullreq-label:pullreq topic:id)
+ :join label :on (= label:id pullreq-label:id)]))
+ ,@(cond
+ ((not marks) nil)
+ ((eq type 'issue)
+ [:join issue-mark :on (= issue-mark:issue topic:id)
+ :join mark :on (= mark:id issue-mark:id)])
+ ([:join pullreq-mark :on (= pullreq-mark:pullreq topic:id)
+ :join mark :on (= mark:id pullreq-mark:id)]))
+ ,@(cond
+ ((not assignee) nil)
+ ((eq type 'issue)
+ [:join issue-assignee :on (= issue-assignee:issue topic:id)
+ :join assignee :on (= assignee:id issue-assignee:id)])
+ ([:join pullreq-assignee :on (= pullreq-assignee:pullreq topic:id)
+ :join assignee :on (= assignee:id pullreq-assignee:id)]))
+ ,@(cond
+ (reviewer
+ [:join (as pullreq-review-request r) :on (= r:pullreq topic:id)
+ :join assignee :on (= assignee:id r:id)]))
+ :where
+ (and
+ ,@(and (not global) repo `((= topic:repository ,(oref repo id))))
+ ,@(cond
+ ((and active state status)
+ `((or (in topic:state ,(vconcat (ensure-list state)))
+ (in topic:status ,(vconcat (ensure-list status))))))
+ (`(,@(and state `((in topic:state ,(vconcat (ensure-list state)))))
+ ,@(and status `((in topic:status ,(vconcat (ensure-list status))))))))
+ ,@(and milestone '((= topic:milestone milestone:id)))
+ ,@(and labels `((or ,@(mapcar (lambda (l) `(= label:name ,l)) labels))))
+ ,@(and marks `((or ,@(mapcar (lambda (m) `(= mark:name ,m)) marks))))
+ ,@(and saved '((= topic:saved-p 't)))
+ ,@(and author `((= topic:author ,author)))
+ ,@(and assignee `((= assignee:login ,assignee)))
+ ,@(and reviewer `((= assignee:login ,reviewer))))
+ :order-by [,(pcase order
+ ('newest '(desc topic:number))
+ ('oldest '(asc topic:number))
+ ('recently-updated '(desc topic:updated))
+ ('anciently-updated '(asc topic:updated)))]
+ ,@(and limit `(:limit ,limit))]))
+
+;;; Read
+
+(defun forge-read-topic (prompt)
+ "Read an active topic with completion using PROMPT.
+
+Open, unread and pending topics are considered active.
+Default to the current topic, even if it isn't active.
+
+\\<forge-read-topic-minibuffer-map>While completion is in \
+progress, \\[forge-read-topic-lift-limit] lifts the limit, extending
+the completion candidates to include all topics.
+
+If `forge-limit-topic-choices' is nil, then all candidates
+can be selected from the start."
+ (forge--read-topic prompt
+ #'forge-current-topic
+ (forge--topics-spec :type 'topic :active t)
+ (forge--topics-spec :type 'topic :active nil :state nil)))
+
+(defun forge--read-topic (prompt current active all)
+ (let* ((current (funcall current))
+ (repo (forge-get-repository (or current :tracked)))
+ (default (and current (forge--format-topic-line current)))
+ (alist (forge--topic-collection
+ (forge--list-topics (if forge-limit-topic-choices active all)
+ repo)))
+ (choices (mapcar #'car alist))
+ (choices (cond ((and forge-limit-topic-choices
+ default
+ (not (member default choices)))
+ (push (cons default (oref current id)) alist)
+ (cons default choices))
+ (choices)))
+ (choice
+ (if forge-limit-topic-choices
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (use-local-map (make-composed-keymap
+ forge-read-topic-minibuffer-map
+ (current-local-map))))
+ (magit-completing-read
+ (substitute-command-keys
+ (format "%s \\<%s> (\\[%s] for all)" prompt
+ 'forge-read-topic-minibuffer-map
+ 'forge-read-topic-lift-limit))
+ (completion-table-dynamic
+ (let (all-choices)
+ (lambda (_string)
+ (cond
+ (all-choices)
+ (forge-limit-topic-choices choices)
+ (t
+ (forge--replace-minibuffer-prompt (concat prompt ": "))
+ (setq alist (forge--topic-collection
+ (forge--list-topics all repo)))
+ (setq all-choices (mapcar #'car alist)))))))
+ nil t nil nil default))
+ (magit-completing-read prompt choices nil t nil nil default))))
+ (cdr (assoc choice alist))))
+
+(defun forge--topic-collection (topics)
+ (mapcar (lambda (topic)
+ (cons (forge--format-topic-line topic)
+ (oref topic id)))
+ topics))
+
+(defvar-keymap forge-read-topic-minibuffer-map
+ "+" #'forge-read-topic-lift-limit)
+
+(defun forge-read-topic-lift-limit ()
+ "No longer limit completion candidates to active topics."
+ (interactive)
+ (when (and (minibufferp)
+ forge-limit-topic-choices)
+ (setq-local forge-limit-topic-choices nil)
+ (when (and (bound-and-true-p vertico-mode)
+ (boundp 'vertico--input)
+ (fboundp 'vertico--exhibit))
+ (setq vertico--input t)
+ (vertico--exhibit))))
+
+(defun forge--replace-minibuffer-prompt (prompt)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((inhibit-read-only t)
+ (end (length prompt)))
+ ;; (insert-and-inherit prompt) would discard all faces already
+ ;; present in PROMPT, so instead we do it like `read_minibuf'.
+ (put-text-property 0 end 'front-sticky t prompt)
+ (put-text-property 0 end 'rear-nonsticky t prompt)
+ (put-text-property 0 end 'field t prompt)
+ (let ((props minibuffer-prompt-properties))
+ (while props
+ (let ((key (pop props))
+ (val (pop props)))
+ (if (eq key 'face)
+ (add-face-text-property 0 end val t prompt)
+ (put-text-property 0 end key val prompt)))))
+ (insert prompt)
+ (delete-region (point) (minibuffer-prompt-end)))))
+
+(defun forge-topic-completion-at-point ()
+ (let ((bol (line-beginning-position))
+ repo)
+ (and (looking-back "[!#][0-9]*" bol)
+ (or (not bug-reference-prog-mode)
+ (nth 8 (syntax-ppss))) ; inside comment or string
+ (setq repo (forge-get-repository :tracked))
+ (looking-back (if (forge--childp repo 'forge-gitlab-repository)
+ "\\(?3:[!#]\\)\\(?2:[0-9]*\\)"
+ "#\\(?2:[0-9]*\\)")
+ bol)
+ (list (match-beginning 2)
+ (match-end 0)
+ (mapcar (lambda (row)
+ (propertize (number-to-string (car row))
+ :title (format " %s" (cadr row))))
+ (if (forge--childp repo 'forge-gitlab-repository)
+ (forge-sql [:select [number title]
+ :from $i1
+ :where (= repository $s2)
+ :order-by [(desc updated)]]
+ (if (equal (match-string 3) "#")
+ 'issue
+ 'pullreq)
+ (oref repo id))
+ (forge-sql [:select [number title updated]
+ :from pullreq
+ :where (= repository $s1)
+ :union
+ :select [number title updated]
+ :from issue
+ :where (= repository $s1)
+ :order-by [(desc updated)]]
+ (oref repo id))))
+ :annotation-function (lambda (c) (get-text-property 0 :title c))))))
+
+(defun forge-read-topic-title (topic)
+ (read-string "Title: " (oref topic title)))
+
+(defun forge-read-topic-milestone (&optional topic)
+ (forge--completing-read
+ "Milestone"
+ (mapcar #'caddr (oref (forge-get-repository (or topic :tracked)) milestones))
+ nil t
+ (and topic (forge--format-topic-milestone topic))))
+
+(defun forge-read-topic-labels (&optional obj)
+ (let ((crm-separator ","))
+ (magit-completing-read-multiple
+ "Labels: "
+ (forge--format-labels (and obj (forge-get-repository obj)))
+ nil t
+ (and (cl-typep obj 'forge-topic)
+ (forge--format-labels obj crm-separator)))))
+
+(defun forge-read-topic-marks (&optional obj)
+ (let ((crm-separator ","))
+ (magit-completing-read-multiple
+ "Marks: " (forge--format-marks) nil t
+ (and (cl-typep obj 'forge-topic)
+ (forge--format-marks obj crm-separator)))))
+
+(defun forge-read-topic-assignees (&optional topic)
+ (let* ((repo (forge-get-repository (or topic :tracked)))
+ (value (and topic (oref topic assignees)))
+ (choices (mapcar #'cadr (oref repo assignees)))
+ (crm-separator ","))
+ (magit-completing-read-multiple
+ "Assignees: " choices nil
+ (if (forge--childp repo 'forge-gitlab-repository)
+ t ; Selecting something else would fail later on.
+ 'confirm)
+ (mapconcat #'cadr value ","))))
+
+(defun forge-read-topic-review-requests (&optional topic)
+ (let* ((repo (forge-get-repository (or topic :tracked)))
+ (value (and topic (oref topic review-requests)))
+ (choices (mapcar #'cadr (oref repo assignees)))
+ (crm-separator ","))
+ (magit-completing-read-multiple
+ "Request review from: " choices nil
+ 'confirm
+ (mapconcat #'cadr value ","))))
+
+(defun forge--completing-read ( prompt collection &optional
+ predicate require-match initial-input
+ hist def)
+ ;; NOTE Only required until `magit-completing-read' has been
+ ;; updated to allow empty input if require-match is t.
+ (let ((reply (funcall magit-completing-read-function
+ (concat prompt ": ")
+ (if (and def (not (member def collection)))
+ (cons def collection)
+ collection)
+ predicate
+ require-match initial-input hist def)))
+ (if (equal reply "")
+ (if (and require-match (not (eq require-match t)))
+ (user-error "Nothing selected")
+ nil)
+ reply)))
+
+;;; Format
+
+(cl-defmethod forge--format ((topic forge-topic) slot &optional spec)
+ (forge--format (forge-get-repository topic) slot
+ `(,@spec (?i . ,(oref topic number)))))
+
+(defun forge--format-topic-line (topic &optional width)
+ (concat
+ (and (or (and (derived-mode-p 'forge-notifications-mode)
+ (eq forge-notifications-display-style 'flat))
+ (and (derived-mode-p 'forge-topics-mode)
+ (oref forge--buffer-topics-spec global)
+ (not (oref forge--buffer-topics-spec grouped))))
+ (concat (truncate-string-to-width
+ (oref (forge-get-repository topic) slug)
+ forge-topic-repository-slug-width
+ nil ?\s t)
+ " "))
+ ;; MAYBE bring this back once we support discussions.
+ ;; (cond (no-indicator nil)
+ ;; ((forge-issue-p topic) (magit--propertize-face "I " 'magit-dimmed))
+ ;; ((forge-pullreq-p topic) (magit--propertize-face "P " 'magit-dimmed))
+ ;; (t (magit--propertize-face "* " 'error)))
+ (string-pad (forge--format-topic-slug topic) (or width 5))
+ " "
+ (forge--format-topic-title topic)))
+
+(defun forge--format-topic-slug (topic)
+ (with-slots (slug state status saved-p) topic
+ (magit--propertize-face
+ slug
+ `(,@(and saved-p '(forge-topic-slug-saved))
+ ,@(and (eq status 'unread) '(forge-topic-slug-unread))
+ ,(pcase state
+ ('open 'forge-topic-slug-open)
+ ((or 'completed 'merged) 'forge-topic-slug-completed)
+ ((or 'unplanned 'rejected) 'forge-topic-slug-unplanned))))))
+
+(defun forge--format-topic-refs (topic)
+ (pcase-let
+ (((eieio cross-repo-p base-repo base-ref head-repo head-ref) topic)
+ (separator (magit--propertize-face ":" 'magit-dimmed))
+ (deleted (magit--propertize-face "(deleted)" 'magit-dimmed)))
+ (concat (if cross-repo-p
+ (concat base-repo separator base-ref)
+ base-ref)
+ (magit--propertize-face "..." 'magit-dimmed)
+ (if cross-repo-p
+ (if (and head-repo head-ref)
+ (concat head-repo separator head-ref)
+ deleted)
+ (or head-ref deleted)))))
+
+(defun forge--format-topic-draft (topic)
+ (if (oref topic draft-p)
+ (magit--propertize-face "yes" 'bold)
+ (magit--propertize-face "no" 'magit-dimmed)))
+
+(defun forge--format-topic-saved (topic)
+ (if (oref topic saved-p)
+ (magit--propertize-face "yes" 'bold)
+ (magit--propertize-face "no" 'magit-dimmed)))
+
+(defun forge--format-topic-title (topic)
+ (with-slots (title status state) topic
+ (magit-log-propertize-keywords
+ nil
+ (magit--propertize-face
+ title
+ `(,@(and (forge-pullreq-p topic)
+ (oref topic draft-p)
+ '(forge-pullreq-draft))
+ ,(pcase status
+ ('unread 'forge-topic-unread)
+ ('pending 'forge-topic-pending)
+ ('done 'forge-topic-done))
+ ,(pcase (list (eieio-object-class topic) state)
+ (`(forge-issue open) 'forge-issue-open)
+ (`(forge-issue completed) 'forge-issue-completed)
+ (`(forge-issue unplanned) 'forge-issue-unplanned)
+ (`(forge-pullreq open) 'forge-pullreq-open)
+ (`(forge-pullreq merged) 'forge-pullreq-merged)
+ (`(forge-pullreq rejected) 'forge-pullreq-rejected)))))))
+
+(defun forge--format-topic-milestone (topic)
+ (and-let* ((id (oref topic milestone))
+ (str (caar (forge-sql [:select [title]
+ :from milestone
+ :where (= id $s1)]
+ id))))
+ (magit--propertize-face str 'forge-topic-label)))
+
+(defun forge--format-labels (&optional arg concat)
+ (and-let*
+ ((local t)
+ (labels (cond
+ ((eieio-object-p arg)
+ (oref arg labels))
+ ((forge-buffer-repository)
+ (forge-sql-cdr `[:select label:* :from label :where
+ ,(if arg
+ '(and (= repository $s1)
+ (in name $v2))
+ '(= repository $s1))
+ :order-by [(asc name)]]
+ forge-buffer-repository
+ (vconcat arg)))
+ (t
+ (setq local nil)
+ (forge-sql `[:select :distinct name :from label
+ ,@(and arg '(:where (in name $v1)))
+ :order-by [(asc name)]]
+ (vconcat arg)))))
+ (format (if local
+ (pcase-lambda (`(,_id ,name ,color ,_description))
+ (let* ((background (forge--sanitize-color color))
+ (foreground (readable-foreground-color background)))
+ (magit--propertize-face
+ name `(( :background ,background
+ :foreground ,foreground)
+ forge-topic-label))))
+ (pcase-lambda (`(,name))
+ (magit--propertize-face name 'forge-topic-label)))))
+ (if concat
+ (mapconcat format labels (if (stringp concat) concat " "))
+ (mapcar format labels))))
+
+(defun forge--format-marks (&optional arg concat)
+ (and-let* ((marks (if (forge-topic--eieio-childp arg)
+ (oref arg marks)
+ ;; Unlike labels, marks are not repo-specific.
+ (when (forge-repository-p arg) (setq arg nil))
+ (forge-sql-cdr `[:select * :from mark
+ ,@(and arg '(:where (in name $v1)))
+ :order-by [(asc name)]]
+ (vconcat arg))))
+ (format (pcase-lambda (`(,_id ,name ,face ,_description))
+ (magit--propertize-face
+ name (list face 'forge-topic-label)))))
+ (if concat
+ (mapconcat format marks (if (stringp concat) concat " "))
+ (mapcar format marks))))
+
+(defun forge--format-topic-state (topic)
+ (with-slots (state) topic
+ (magit--propertize-face
+ (symbol-name state)
+ (pcase (list (if (forge-issue-p topic) 'issue 'pullreq) state)
+ ('(issue open) 'forge-issue-open)
+ ('(issue closed) 'forge-issue-completed)
+ ('(issue completed) 'forge-issue-completed)
+ ('(issue unplanned) 'forge-issue-unplanned)
+ ('(pullreq open) 'forge-pullreq-open)
+ ('(pullreq merged) 'forge-pullreq-merged)
+ ('(pullreq closed) 'forge-pullreq-rejected)))))
+
+(defun forge--format-topic-status (topic)
+ (with-slots (status) topic
+ (magit--propertize-face
+ (symbol-name status)
+ (pcase status
+ ('unread 'forge-topic-unread)
+ ('pending 'forge-topic-pending)
+ ('done 'forge-topic-done)))))
+
+(defun forge--format-topic-assignees (topic)
+ (and-let* ((assignees (oref topic assignees)))
+ (mapconcat #'forge--format-person assignees ", ")))
+
+(defun forge--format-topic-review-requests (topic)
+ (and-let* ((review-requests (oref topic review-requests)))
+ (mapconcat #'forge--format-person review-requests ", ")))
+
+(defun forge--format-person (person)
+ (pcase-let ((`(,_id ,login ,name) person))
+ (format "%s%s (@%s)"
+ (forge--format-avatar login)
+ name login)))
+
+(defun forge--format-avatar (person)
+ (if forge-format-avatar-function
+ (funcall forge-format-avatar-function person)
+ ""))
+
+(defun forge--format-boolean (slot name &optional obj)
+ ;; Booleans are formatted differently in transients and headers.
+ ;; Use this to format the (complete) description of suffix commands.
+ (let ((obj (or obj (forge-current-topic))))
+ (if (and obj (slot-exists-p obj slot))
+ (format (propertize "[%s]" 'face 'transient-delimiter)
+ (propertize name 'face
+ (if (eieio-oref obj slot)
+ 'transient-value
+ 'transient-inactive-value)))
+ (format "[%s]" name))))
+
+;;; Insert
+
+(defun forge-insert-topics (type heading prepare)
+ "Insert a list of topics, according to PREPARE.
+
+This function is not intended to be added to section hooks directly.
+Instead create a function, which calls this function, and add wrapper
+to the section hook.
+
+PREPARE is a function which takes one arguments the repository object,
+and must return an filter object of type `forge--topics-spec' or nil.
+Insert no topics if PREPARE returns nil, or if the current repository
+isn't tracked or Forge hasn't been fully setup yet (in the latter two
+cases don't even call PREPARE).
+
+The filter object can be created either using `forge--topics-spec' or
+by `clone'ing the object returned by `forge--init-buffer-topics-spec',
+to share some settings with other topic lists in the same buffer.
+See `forge--topics-spec' for the valid slots and their values.
+
+HEADING is used as the heading of the list section and TYPE is used as
+its type. TYPE should be a symbol of the form `SUBSET-KIND', where KIND
+is one of `topics', `issues' or `pullreqs', and SUBSET should describe
+what subset of KIND is being listed."
+ (declare (indent defun))
+ (when-let (((forge-db t))
+ (repo (forge-get-repository :tracked?))
+ (spec (funcall prepare repo)))
+ (forge--insert-topics type heading (forge--list-topics spec repo))))
+
+(defun forge--insert-topics (type heading topics)
+ (when topics
+ (let ((width (apply #'max (--map (length (oref it slug)) topics))))
+ (magit-insert-section ((eval type) heading t)
+ (magit-insert-heading
+ (concat (magit--propertize-face (concat heading " ")
+ 'magit-section-heading)
+ (magit--propertize-face (format "(%s)" (length topics))
+ 'magit-section-child-count)))
+ (magit-insert-section-body
+ (dolist (topic topics)
+ (forge--insert-topic topic width))
+ (insert ?\n)
+ (magit-make-margin-overlay nil t))))))
+
+(defun forge--insert-topic (topic &optional width)
+ (magit-insert-section ((eval (oref topic closql-table)) topic t)
+ (insert (forge--format-topic-line topic (or width 5)))
+ (forge--insert-topic-marks topic t)
+ (forge--insert-topic-labels topic t)
+ (insert "\n")
+ (magit-log-format-author-margin
+ (oref topic author)
+ (format-time-string "%s" (parse-iso8601-time-string (oref topic created)))
+ t)
+ (when (and (slot-exists-p topic 'merged)
+ (not (oref topic merged)))
+ (magit-insert-heading)
+ (magit-insert-section-body
+ (forge--insert-pullreq-commits topic)))))
+
+(defun forge--insert-topic-labels (topic &optional separate)
+ (and-let* ((labels (oref topic labels)))
+ (prog1 t
+ (pcase-dolist (`(,_id ,name ,color ,description) labels)
+ (let* ((background (forge--sanitize-color color))
+ (foreground (readable-foreground-color background)))
+ (if separate (insert " ") (setq separate t))
+ (insert name)
+ (let ((o (make-overlay (- (point) (length name)) (point))))
+ (overlay-put o 'priority 2)
+ (overlay-put o 'evaporate t)
+ (overlay-put o 'font-lock-face
+ `(( :background ,background
+ :foreground ,foreground)
+ forge-topic-label))
+ (when description
+ (overlay-put o 'help-echo description))))))))
+
+(defun forge--insert-topic-marks (topic &optional separate)
+ (and-let* ((marks (oref topic marks)))
+ (prog1 t
+ (pcase-dolist (`(,_id ,name ,face ,description) marks)
+ (if separate (insert " ") (setq separate t))
+ (insert name)
+ (let ((o (make-overlay (- (point) (length name)) (point))))
+ (overlay-put o 'priority 2)
+ (overlay-put o 'evaporate t)
+ (overlay-put o 'font-lock-face (list face 'forge-topic-label))
+ (when description
+ (overlay-put o 'help-echo description)))))))
+
+;;; Modes
+
+(defvar-keymap forge-common-map
+ :doc "Parent keymap of many of Forge's keymaps.
+Keymaps that use this keymap as the/a parent keymap, remap the
+place-holder commands `forge--list-menu' and/or `forge--item-menu'
+to the appropriate menu command. To change the keys bound to menu
+commands in all Forge keymaps, one only has to change them here."
+ "C-c C-c" #'forge--list-menu
+ "C-c RET" #'forge--item-menu
+ "C-<return>" #'forge--item-menu)
+
+(defun forge--list-menu ()
+ "Place-holder menu command. See `forge-common-map'."
+ (interactive)
+ (message "No list menu available here"))
+(put 'forge--list-menu 'completion-predicate #'ignore)
+
+(defun forge--item-menu ()
+ "Place-holder menu command. See `forge-common-map'."
+ (interactive)
+ (message "No item menu available here"))
+(put 'forge--item-menu 'completion-predicate #'ignore)
+
+(defvar-keymap forge-post-section-map
+ "<remap> <magit-edit-thing>" #'forge-edit-post
+ "C-c C-k" #'forge-delete-comment)
+
+(defvar-keymap forge-topic-mode-map
+ :parent (make-composed-keymap forge-common-map magit-mode-map)
+ "<remap> <magit-visit-thing>" #'markdown-follow-link-at-point
+ "<mouse-2>" #'markdown-follow-link-at-point
+ "<remap> <forge--item-menu>" #'forge-topic-menu
+ "<remap> <forge--list-menu>" #'forge-topic-menu
+ "C-c C-n" #'forge-create-post
+ "C-c C-r" #'forge-create-post)
+
+(define-derived-mode forge-topic-mode magit-mode "Topic"
+ "Parent major mode of `forge-{issue,pullreq}-mode'.
+This mode itself is never used directly."
+ :interactive nil
+ (face-remap-add-relative 'header-line 'forge-topic-header-line)
+ (setq-local markdown-translate-filename-function
+ #'forge--markdown-translate-filename-function))
+
+(defvar-keymap forge-issue-mode-map :parent forge-topic-mode-map)
+(define-derived-mode forge-issue-mode forge-topic-mode "Issue"
+ "Major mode for looking at a Forge issue."
+ :interactive nil)
+(defalias 'forge-issue-setup-buffer #'forge-topic-setup-buffer)
+(defalias 'forge-issue-refresh-buffer #'forge-topic-refresh-buffer)
+(defvar forge-issue-headers-hook
+ '(forge-insert-topic-state
+ forge-insert-topic-status
+ forge-insert-topic-milestone
+ forge-insert-topic-labels
+ forge-insert-topic-marks
+ forge-insert-topic-assignees))
+
+(defvar-keymap forge-pullreq-mode-map :parent forge-topic-mode-map)
+(define-derived-mode forge-pullreq-mode forge-topic-mode "Pull-request"
+ "Major mode for looking at a Forge pull-request."
+ :interactive nil)
+(defalias 'forge-pullreq-setup-buffer #'forge-topic-setup-buffer)
+(defalias 'forge-pullreq-refresh-buffer #'forge-topic-refresh-buffer)
+(defvar forge-pullreq-headers-hook
+ '(forge-insert-topic-state
+ forge-insert-topic-draft
+ forge-insert-topic-status
+ forge-insert-topic-saved
+ forge-insert-topic-refs
+ forge-insert-topic-milestone
+ forge-insert-topic-labels
+ forge-insert-topic-marks
+ forge-insert-topic-assignees
+ forge-insert-topic-review-requests))
+
+(defvar-local forge-buffer-topic nil)
+
+(defun forge-topic-setup-buffer (topic)
+ (let* ((repo (forge-get-repository topic))
+ (name (format "*forge: %s %s*" (oref repo slug) (oref topic slug)))
+ (magit-generate-buffer-name-function (lambda (_mode _value) name)))
+ (magit-setup-buffer-internal
+ (if (forge-issue-p topic) #'forge-issue-mode #'forge-pullreq-mode)
+ t `((forge-buffer-topic ,topic))
+ name (or (forge-get-worktree repo) "/"))
+ (forge-topic-mark-read topic)))
+
+(defun forge-topic-refresh-buffer ()
+ (let ((topic (closql-reload forge-buffer-topic)))
+ (setq forge-buffer-topic topic)
+ (magit-set-header-line-format (forge--format-topic-line topic))
+ (magit-insert-section (topicbuf)
+ (magit-insert-headers
+ (intern (format "%s-headers-hook"
+ (substring (symbol-name major-mode) 0 -5))))
+ (when (forge-pullreq-p topic)
+ (magit-insert-section (pullreq topic)
+ (magit-insert-heading "Commits")
+ (forge--insert-pullreq-commits topic t)))
+ (when-let ((note (oref topic note)))
+ (magit-insert-section (note)
+ (magit-insert-heading "Note")
+ (insert (forge--fontify-markdown note) "\n\n")))
+ (dolist (post (cons topic (oref topic posts)))
+ (with-slots (author created body) post
+ (magit-insert-section
+ ( post post nil
+ :heading-highlight-face 'magit-diff-hunk-heading-highlight)
+ (let ((heading
+ (format-spec
+ forge-post-heading-format
+ `((?a . ,(propertize (concat (forge--format-avatar author)
+ (or author "(ghost)"))
+ 'font-lock-face 'forge-post-author))
+ (?c . ,(propertize created 'font-lock-face 'forge-post-date))
+ (?C . ,(propertize (apply #'format "%s %s ago"
+ (magit--age
+ (float-time
+ (date-to-time created))))
+ 'font-lock-face 'forge-post-date))))))
+ (font-lock-append-text-property
+ 0 (length heading)
+ 'font-lock-face 'magit-diff-hunk-heading heading)
+ (magit-insert-heading heading))
+ (insert (forge--fontify-markdown body) "\n\n"))))
+ (when (and (display-images-p)
+ (fboundp 'markdown-display-inline-images))
+ (let ((markdown-display-remote-images t))
+ (markdown-display-inline-images))))))
+
+(cl-defmethod magit-buffer-value (&context (major-mode forge-topic-mode))
+ (oref forge-buffer-topic slug))
+
+;;; Headers
+
+(cl-defmacro forge--define-topic-header
+ (name &key insert format (command nil command?))
+ (declare (indent defun))
+ (let ((fun (intern (format "forge-insert-topic-%s" name)))
+ (map (intern (format "forge-topic-%s-section-map" name)))
+ (cmd (intern (format "forge-topic-set-%s" name))))
+ `(progn
+ (cl-defun ,fun (&optional (topic forge-buffer-topic))
+ (magit-insert-section (,(intern (format "topic-%s" name)))
+ (insert ,(capitalize (string-pad (format "%s: " name) 11)))
+ ,(cond
+ (insert
+ `(unless (funcall ,insert topic)
+ (insert (magit--propertize-face "none" 'magit-dimmed))))
+ (format
+ `(insert (or (funcall ,format topic)
+ (magit--propertize-face "none" 'magit-dimmed)))))
+ (insert ?\n)))
+ ,@(and (if command? command t)
+ `((defvar-keymap ,map "<remap> <magit-edit-thing>"
+ ,(or command `(function ,cmd)))
+ (put ',fun 'definition-name ',name)))
+ (put ',map 'definition-name ',name))))
+
+(forge--define-topic-header refs
+ :command nil
+ :format #'forge--format-topic-refs)
+
+(forge--define-topic-header draft
+ :command #'forge-topic-toggle-draft
+ :format #'forge--format-topic-draft)
+
+(forge--define-topic-header saved
+ :command #'forge-topic-toggle-saved
+ :format #'forge--format-topic-saved)
+
+(forge--define-topic-header state
+ :command #'forge-topic-state-menu
+ :format #'forge--format-topic-state)
+
+(forge--define-topic-header status
+ :command #'forge-topic-status-menu
+ :format #'forge--format-topic-status)
+
+(forge--define-topic-header milestone
+ :format #'forge--format-topic-milestone)
+
+(forge--define-topic-header labels
+ :insert #'forge--insert-topic-labels)
+
+(forge--define-topic-header marks
+ :insert #'forge--insert-topic-marks)
+
+(forge--define-topic-header assignees
+ :format #'forge--format-topic-assignees)
+
+(forge--define-topic-header review-requests
+ :format #'forge--format-topic-review-requests)
+
+;;; Commands
+;;;; Groups
+
+(defconst forge--lists-group
+ ["List"
+ ("l r" "repositories" forge-list-repositories)
+ ("l n" "notifications" forge-list-notifications)
+ ("l g" "global topics" forge-list-global-topics)
+ ("l t" "topics" forge-list-topics)
+ ""])
+
+(defconst forge--topic-menus-group
+ ["Menu"
+ ("m s" "edit" forge-topic-menu)
+ ("m f" "filter" forge-topics-menu)
+ ("m f" "filter" forge-notifications-menu)
+ ("m f" "filter" forge-repositories-menu)
+ ("m d" "dispatch" forge-dispatch)
+ ("m c" "configure" forge-configure)
+ ""])
+
+(defconst forge--topic-set-state-group
+ [:description
+ (lambda () (if forge--show-topic-legend "Set public state" "Set state"))
+ ("o" forge-topic-state-set-open)
+ ("c" forge-issue-state-set-completed)
+ ("x" forge-issue-state-set-unplanned)
+ ("c" forge-pullreq-state-set-merged)
+ ("x" forge-pullreq-state-set-rejected)])
+
+(defconst forge--topic-set-status-group
+ [:description
+ (lambda () (if forge--show-topic-legend "Set private status" "Set status"))
+ ("u" forge-topic-status-set-unread)
+ ("p" forge-topic-status-set-pending)
+ ("d" forge-topic-status-set-done)])
+
+(defconst forge--topic-legend-group
+ '(["Legend" :if-non-nil forge--show-topic-legend
+ (:info* (lambda () (propertize "open issue" 'face 'forge-issue-open)))
+ (:info* (lambda () (propertize "completed issue" 'face 'forge-issue-completed)))
+ (:info* (lambda () (propertize "unplanned issue" 'face 'forge-issue-unplanned)))]
+ ["" :if-non-nil forge--show-topic-legend
+ (:info* (lambda () (propertize "open pullreq" 'face 'forge-pullreq-open)))
+ (:info* (lambda () (propertize "merged pullreq" 'face 'forge-pullreq-merged)))
+ (:info* (lambda () (propertize "rejected pullreq" 'face 'forge-pullreq-rejected)))]
+ ["" :if-non-nil forge--show-topic-legend
+ (:info* (lambda () (propertize "unread" 'face 'forge-topic-unread)))
+ (:info* (lambda () (propertize "pending" 'face 'forge-topic-pending)))
+ (:info* (lambda () (propertize "done" 'face 'forge-topic-done)))]
+ ["" :if-non-nil forge--show-topic-legend
+ (:info* (lambda () (propertize "draft" 'face 'forge-pullreq-draft)))]))
+
+(defvar forge--show-topic-legend t)
+
+(transient-define-suffix forge-toggle-topic-legend ()
+ "Toggle whether to show legend for faces used in topic menus and lists."
+ :description (lambda () (if forge--show-topic-legend "hide legend" "show legend"))
+ :transient t
+ (interactive)
+ (customize-set-variable 'forge--show-topic-legend
+ (not forge--show-topic-legend)))
+
+(defconst forge--topic-menus-column-widths '(21 21 21 21))
+
+;;;; Menus
+
+;;;###autoload(autoload 'forge-topic-menu "forge-topic" nil t)
+(transient-define-prefix forge-topic-menu ()
+ "Edit the topic at point."
+ :transient-suffix t
+ :transient-non-suffix #'transient--do-call
+ :transient-switch-frame nil
+ :refresh-suffixes t
+ :environment #'forge--menu-environment
+ :column-widths forge--topic-menus-column-widths
+ [:hide always ("q" forge-menu-quit-list)]
+ [forge--topic-menus-group
+ forge--topic-set-state-group
+ forge--topic-set-status-group
+ ["Actions"
+ ("/f" forge-pull-this-topic)
+ ("/b" forge-browse-this-topic)
+ ("/c" forge-checkout-this-pullreq)]]
+ [forge--lists-group
+ ["Set "
+ ("-m" forge-topic-set-milestone)
+ ("-l" forge-topic-set-labels)
+ ("-x" forge-topic-set-marks)
+ ("-a" forge-topic-set-assignees)
+ ("-r" forge-topic-set-review-requests)
+ ("-n" forge-edit-topic-note)
+ ("-t" forge-topic-set-title)]
+ ["Set"
+ ("-s" forge-topic-toggle-saved)
+ ("-d" forge-topic-toggle-draft)
+ """Display"
+ ("-H" forge-toggle-topic-legend)]]
+ [forge--topic-legend-group])
+
+(transient-augment-suffix forge-topic-menu
+ :transient #'transient--do-replace
+ :inapt-if (lambda () (or (derived-mode-p 'forge-repository-list-mode)
+ (eq (oref transient--prefix command) 'forge-topic-menu)))
+ :inapt-face (lambda () (if (derived-mode-p 'forge-repository-list-mode)
+ 'transient-inapt-suffix
+ 'forge-suffix-active)))
+
+;;;###autoload(autoload 'forge-topic-state-menu "forge-topic" nil t)
+(transient-define-prefix forge-topic-state-menu ()
+ "Set state of the current topic."
+ :environment #'forge--menu-environment
+ [forge--topic-set-state-group])
+
+;;;###autoload(autoload 'forge-topic-status-menu "forge-topic" nil t)
+(transient-define-prefix forge-topic-status-menu ()
+ "Set status of the current topic."
+ :environment #'forge--menu-environment
+ [forge--topic-set-status-group])
+
+(defun forge--menu-environment (fn)
+ (let ((magit--refresh-cache (list (cons 0 0))))
+ (funcall fn)))
+
+;;;; State
+
+(defclass forge--topic-set-state-command (transient-suffix)
+ ((state :initarg :state)
+ (getter :initarg :getter)
+ (definition
+ :initform (lambda ()
+ (interactive)
+ (with-slots (getter state) (transient-suffix-object)
+ (let ((topic (funcall getter t)))
+ (forge--set-topic-state (forge-get-repository topic)
+ topic state)))))
+ (description
+ :initform (lambda (obj)
+ (symbol-name (oref obj state))))
+ (inapt-if
+ :initform (lambda ()
+ (or (forge-region-topics)
+ (with-slots (getter state) (transient-suffix-object)
+ (if-let ((topic (funcall getter)))
+ ;; Once a pull-request is merged,
+ ;; its state cannot be changed anymore.
+ (memq (oref topic state) (list state 'merged))
+ t)))))
+ (inapt-face
+ :initform (lambda (obj)
+ (with-slots (getter state) (transient-suffix-object)
+ (if (and (not (forge-region-topics))
+ (and-let* ((topic (funcall getter)))
+ (eq (oref topic state) state)))
+ 'forge-suffix-active
+ 'transient-inapt-suffix))))))
+
+(transient-define-suffix forge-topic-state-set-open ()
+ "Set the state of the current topic to `open'."
+ :class 'forge--topic-set-state-command
+ :state 'open
+ :getter #'forge-current-topic)
+
+(transient-define-suffix forge-issue-state-set-completed ()
+ "Set the state of the current issue to `completed'."
+ :class 'forge--topic-set-state-command
+ :state 'completed
+ :getter #'forge-current-issue)
+
+(transient-define-suffix forge-issue-state-set-unplanned ()
+ "Set the state of the current issue to `unplanned'."
+ :class 'forge--topic-set-state-command
+ :state 'unplanned
+ :getter #'forge-current-issue)
+
+(transient-define-suffix forge-pullreq-state-set-merged ()
+ "If the current pull-request is merged, then visualize that."
+ :class 'forge--topic-set-state-command
+ :state 'merged
+ :getter #'forge-current-pullreq
+ (interactive)
+ (message "Please use a merge command for this"))
+
+(transient-define-suffix forge-pullreq-state-set-rejected ()
+ "Set the state of the current pull-request to `rejected'."
+ :class 'forge--topic-set-state-command
+ :state 'rejected
+ :getter #'forge-current-pullreq)
+
+;;;; Status
+
+(defclass forge--topic-set-status-command (transient-suffix)
+ ((status :initarg :status)
+ (definition
+ :initform (lambda ()
+ (interactive)
+ (with-slots (status) (transient-suffix-object)
+ (if-let ((topics (forge-region-topics)))
+ (dolist (topic topics)
+ (oset topic status status))
+ (oset (forge-current-topic t) status status)))
+ (forge-refresh-buffer)))
+ (description
+ :initform (lambda (obj)
+ (symbol-name (oref obj status))))
+ (inapt-if
+ :initform (lambda ()
+ (and (not (forge-region-topics))
+ (if-let ((topic (forge-current-topic)))
+ (eq (oref topic status)
+ (oref (transient-suffix-object) status))
+ t))))
+ (inapt-face
+ :initform (lambda ()
+ (if (forge-current-topic)
+ 'forge-suffix-active
+ 'transient-inapt-suffix)))))
+
+(transient-define-suffix forge-topic-status-set-unread ()
+ "Set the notification status of the current topic to `unread'."
+ :class 'forge--topic-set-status-command :status 'unread)
+
+(transient-define-suffix forge-topic-status-set-pending ()
+ "Set the notification status of the current topic to `pending'."
+ :class 'forge--topic-set-status-command :status 'pending)
+
+(transient-define-suffix forge-topic-status-set-done ()
+ "Set the notification status of the current topic to `done'."
+ :class 'forge--topic-set-status-command :status 'done)
+
+;;;; Set
+
+(defclass forge--topic-set-slot-command (transient-suffix)
+ ((slot :initarg :slot)
+ (setter)
+ (reader)
+ (formatter :initarg :formatter)
+ (definition
+ :initform (lambda (value)
+ (interactive
+ (list (funcall (oref (transient-suffix-object) reader)
+ (forge-current-topic t))))
+ (let ((topic (forge-current-topic t)))
+ (funcall (oref (transient-suffix-object) setter)
+ (forge-get-repository topic)
+ topic value))))
+ (description
+ :initform (lambda (obj)
+ (with-slots (slot inapt-if-not) obj
+ (if-let* ((topic (if inapt-if-not
+ (funcall inapt-if-not)
+ (forge-current-topic)))
+ (value (funcall (oref obj formatter) topic)))
+ (format "%s %s" slot value)
+ (format "%s" slot)))))))
+
+(cl-defmethod initialize-instance :after
+ ((obj forge--topic-set-slot-command) &optional _slots)
+ (with-slots (slot) obj
+ (let ((name (symbol-name slot)))
+ (cond ((string-suffix-p "-p" name)
+ (setq name (substring name 0 -2))
+ (oset obj reader (lambda (topic) (not (eieio-oref topic slot)))))
+ ((oset obj reader (intern (format "forge-read-topic-%s" name)))))
+ (oset obj setter (intern (format "forge--set-topic-%s" name)))
+ (unless (slot-boundp obj 'formatter)
+ (oset obj formatter (intern (format "forge--format-topic-%s" name)))))))
+
+(transient-define-suffix forge-topic-set-title (title)
+ "Edit the TITLE of the current topic."
+ :class 'forge--topic-set-slot-command :slot 'title
+ :formatter (lambda (topic)
+ (propertize (truncate-string-to-width
+ (forge--format-topic-title topic) 34 nil ?\s t)
+ 'face 'font-lock-string-face)))
+
+(transient-define-suffix forge-topic-set-milestone (milestone)
+ "Edit what MILESTONE the current topic belongs to."
+ :class 'forge--topic-set-slot-command :slot 'milestone)
+
+(transient-define-suffix forge-topic-set-labels (labels)
+ "Edit the LABELS of the current topic."
+ :class 'forge--topic-set-slot-command :slot 'labels
+ :formatter (lambda (topic) (forge--format-labels topic t)))
+
+(transient-define-suffix forge-topic-set-marks (marks)
+ "Edit the MARKS of the current topic."
+ :class 'forge--topic-set-slot-command :slot 'marks
+ :formatter (lambda (topic) (forge--format-marks topic t)))
+
+(transient-define-suffix forge-topic-set-assignees (assignees)
+ "Edit the ASSIGNEES of the current topic."
+ :class 'forge--topic-set-slot-command :slot 'assignees)
+
+(transient-define-suffix forge-topic-set-review-requests (review-requests)
+ "Edit the REVIEW-REQUESTS of the current pull-request."
+ :class 'forge--topic-set-slot-command :slot 'review-requests
+ :inapt-if-not #'forge-current-pullreq)
+
+(transient-define-suffix forge-topic-toggle-draft (draft)
+ "Toggle whether the current pull-request is a draft."
+ :class 'forge--topic-set-slot-command :slot 'draft-p
+ :inapt-if-not #'forge-current-pullreq
+ :description (lambda () (forge--format-boolean 'draft-p "draft")))
+
+(transient-define-suffix forge-topic-toggle-saved ()
+ "Toggle whether this topic is marked as saved."
+ :class 'forge--topic-set-slot-command :slot 'saved-p
+ :description (lambda () (forge--format-boolean 'saved-p "saved"))
+ ;; Set only locally because Github's API does not support this.
+ (interactive)
+ (let ((topic (forge-current-topic t)))
+ (oset topic saved-p (not (oref topic saved-p))))
+ (forge-refresh-buffer))
+
+;;; Color Utilities
+
+(defun forge--sanitize-color (color)
+ (cond ((color-values color) color)
+ ;; Discard alpha information.
+ ((string-match-p "\\`#.\\{4\\}\\'" color) (substring color 0 3))
+ ((string-match-p "\\`#.\\{8\\}\\'" color) (substring color 0 6))
+ (t "#000000"))) ; Use fallback instead of invalid color.
+
+;;; Markdown Utilities
+
+(defun forge--fontify-markdown (text)
+ (with-temp-buffer
+ (delay-mode-hooks
+ (gfm-mode))
+ (insert text)
+ (font-lock-ensure)
+ (when forge-post-fill-region
+ (fill-region (point-min) (point-max)))
+ (buffer-string)))
+
+(defun forge--markdown-translate-filename-function (file)
+ (if (string-match-p "\\`https?://" file)
+ file
+ (let ((host (oref (forge-get-repository :tracked) forge))) ;aka webhost
+ (concat (if (member host ghub-insecure-hosts) "http://" "https://")
+ host
+ (and (not (string-prefix-p "/" file)) "/")
+ file))))
+
+;;; Templates
+
+(defun forge--topic-parse-buffer (&optional file)
+ (save-match-data
+ (save-excursion
+ (goto-char (point-min))
+ (let ((alist (save-excursion (forge--topic-parse-yaml))))
+ (if alist
+ (setf (alist-get 'yaml alist) t)
+ (setq alist (save-excursion (forge--topic-parse-plain))))
+ (setf (alist-get 'file alist) file)
+ (setf (alist-get 'text alist) (magit--buffer-string nil nil ?\n))
+ (when (and file (not (alist-get 'prompt alist)))
+ (setf (alist-get 'prompt alist)
+ (file-name-sans-extension (file-name-nondirectory file))))
+ ;; If there is a yaml front-matter, then it is supposed
+ ;; to have a `title' field, but this may not be the case.
+ (when (and (not file)
+ (not (alist-get 'title alist)))
+ (setf (alist-get 'title alist)
+ (read-string "Title: ")))
+ alist))))
+
+(defun forge--topic-parse-yaml ()
+ (let (alist beg end)
+ (when (looking-at "^---[\s\t]*$")
+ (forward-line)
+ (setq beg (point))
+ (when (re-search-forward "^---[\s\t]*$" nil t)
+ (setq end (match-beginning 0))
+ (setq alist (yaml-parse-string
+ (buffer-substring-no-properties beg end)
+ :object-type 'alist
+ :sequence-type 'list
+ ;; FIXME Does not work because of
+ ;; https://github.com/zkry/yaml.el/pull/28.
+ :false-object nil))
+ (let-alist alist
+ (when (and .name .about)
+ (setf (alist-get 'prompt alist)
+ (format "[%s] %s" .name .about)))
+ (when (and .labels (atom .labels))
+ (setf (alist-get 'labels alist) (list .labels)))
+ (when (and .assignees (atom .assignees))
+ (setf (alist-get 'assignees alist) (list .assignees))))
+ (forward-line)
+ (when (and (not (alist-get 'title alist))
+ (looking-at "^\n?#*"))
+ (goto-char (match-end 0))
+ (setf (alist-get 'title alist)
+ (string-trim
+ (magit--buffer-string (point) (line-end-position) t)))
+ (forward-line))
+ (setf (alist-get 'body alist)
+ (string-trim (magit--buffer-string (point) nil ?\n)))))
+ alist))
+
+(defun forge--topic-parse-plain ()
+ (let (title body)
+ (when (looking-at "\\`#*")
+ (goto-char (match-end 0)))
+ (setq title (magit--buffer-string (point) (line-end-position) t))
+ (forward-line)
+ (setq body (magit--buffer-string (point) nil ?\n))
+ `((title . ,(string-trim title))
+ (body . ,(string-trim body)))))
+
+(defun forge--topic-parse-link-buffer ()
+ (save-match-data
+ (save-excursion
+ (goto-char (point-min))
+ (mapcar (lambda (alist)
+ (cons (cons 'prompt (concat (alist-get 'name alist) " -- "
+ (alist-get 'about alist)))
+ alist))
+ (forge--topic-parse-yaml-links)))))
+
+(defun forge--topic-parse-yaml-links ()
+ (alist-get 'contact_links
+ (yaml-parse-string (buffer-substring-no-properties
+ (point-min)
+ (point-max))
+ :object-type 'alist
+ :sequence-type 'list)))
+
+(cl-defgeneric forge--topic-template-files (repo class)
+ "Return a list of topic template files for REPO and a topic of CLASS.")
+
+(cl-defgeneric forge--topic-template (repo class)
+ "Return a topic template alist for REPO and a topic of CLASS.
+If there are multiple templates, then the user is asked to select
+one of them. It there are no templates, then return a very basic
+alist, containing just `text' and `position'.")
+
+(defun forge--topic-templates-data (repo class)
+ (let ((branch (oref repo default-branch)))
+ (mapcan (lambda (f)
+ (with-temp-buffer
+ (magit-git-insert "cat-file" "-p" (concat branch ":" f))
+ (if (equal (file-name-nondirectory f) "config.yml")
+ (forge--topic-parse-link-buffer)
+ (list (forge--topic-parse-buffer f)))))
+ (forge--topic-template-files repo class))))
+
+(cl-defmethod forge--topic-template ((repo forge-repository)
+ (class (subclass forge-topic)))
+ (let ((choices (forge--topic-templates-data repo class)))
+ (if (cdr choices)
+ (let ((c (magit-completing-read
+ (if (eq class 'forge-pullreq)
+ "Select pull-request template"
+ "Select issue template")
+ (--map (alist-get 'prompt it) choices)
+ nil t)))
+ (--first (equal (alist-get 'prompt it) c) choices))
+ (car choices))))
+
+;;; Bug-Reference
+
+(defvar forge-bug-reference-remote-files t
+ "Whether forge may enable `bug-reference-mode' in remote files.
+See also `forge-bug-reference-setup'.")
+
+(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))
+ (and buffer-file-name
+ (not forge-bug-reference-remote-files)
+ (file-remote-p buffer-file-name))
+ ;; TODO Allow use in these modes again.
+ (derived-mode-p 'forge-topics-mode 'forge-notifications-mode))
+ (magit--with-safe-default-directory nil
+ (when-let ((repo (forge-get-repository :tracked?)))
+ (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)))))))))
+ (if (derived-mode-p 'prog-mode)
+ (bug-reference-prog-mode 1)
+ (bug-reference-mode 1))
+ (add-hook 'completion-at-point-functions
+ #'forge-topic-completion-at-point nil t)))))
+
+(unless noninteractive
+ (dolist (hook forge-bug-reference-hooks)
+ (add-hook hook #'forge-bug-reference-setup)))
+
+;;; _
+(provide 'forge-topic)
+;;; forge-topic.el ends here
--- /dev/null
+;;; forge-topics.el --- List topics -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'forge-topic)
+
+;;; Options
+
+(defcustom forge-list-buffer-default-topic-filters
+ (forge--topics-spec :type 'topic :active t :state 'open :order 'newest)
+ "Filters initially used to limit topics listed in list buffers.
+
+This option controls which topics are listed when initially creating
+a `forge-topics-mode' buffer. To temporarily change which topics are
+listed in a given buffer, instead use \\`N m' (`forge-topics-menu')."
+ :package-version '(forge . "0.4.0")
+ :group 'forge
+ :type 'object)
+
+(defcustom forge-status-buffer-default-topic-filters
+ (forge--topics-spec :type 'topic :active t :state 'open :order 'newest)
+ "Filters initially used to limit topics listed in status buffers.
+
+This option controls which topics are listed when initially creating
+a `magit-status-mode' buffer. To temporarily change which topics are
+listed in a given buffer, instead use \\<forge-topics-mode-map> \
+\\[forge-topics-menu] (`forge-topics-menu').
+
+To initially list no topics, set the `type' slot to nil."
+ :package-version '(forge . "0.4.0")
+ :group 'forge
+ :type 'object)
+
+(defcustom forge-owned-accounts nil
+ "An alist of accounts that are owned by you.
+This should include your username as well as any organization
+that you own. Used by the commands `forge-list-owned-issues',
+`forge-list-owned-pullreqs' and `forge-fork'.
+
+Each element has the form (ACCOUNT . PLIST). The following
+properties are currently being used:
+
+`remote-name' The default name suggested by `forge-fork' for a
+ fork created within this account. If unspecified, then the
+ name of the account is used."
+ :package-version '(forge . "0.2.0")
+ :group 'forge
+ :type '(repeat (cons (string :tag "Account") plist)))
+
+(defcustom forge-owned-ignored nil
+ "A list of repositories that are ignored when listing those owned by you.
+This is a list of package names. Used by the commands
+`forge-list-owned-issues' and `forge-list-owned-pullreqs'."
+ :package-version '(forge . "0.2.0")
+ :group 'forge
+ :type '(repeat (string :tag "Name")))
+
+;;; Faces
+
+(defface forge-suffix-active
+ '((t :inherit transient-value :weight bold))
+ "Face used for suffixes whose effects is currently active."
+ :group 'forge-faces)
+
+(defface forge-suffix-active-and-implied
+ '((t :inherit transient-value :weight semibold))
+ "Face used for suffixes whose effects is currently active and implied."
+ :group 'forge-faces)
+
+(defface forge-suffix-implied
+ '((t :inherit transient-value :weight normal))
+ "Face used for suffixes whose effects is currently implied."
+ :group 'forge-faces)
+
+;;; Mode
+
+(defvar-keymap forge-topics-mode-map
+ :doc "Local keymap for Forge-Topic-List mode buffers."
+ :parent (make-composed-keymap forge-common-map magit-mode-map)
+ "RET" #'forge-visit-this-topic
+ "<return>" #'forge-visit-this-topic
+ "o" #'forge-browse-this-topic
+ "<remap> <forge--list-menu>" #'forge-topics-menu
+ "<remap> <forge--item-menu>" #'forge-topic-menu
+ "<remap> <magit-refresh>" #'forge-refresh-buffer)
+
+(defvar forge-topics-mode-name '((:eval (forge-topics-buffer-desc)))
+ "Information shown in the mode-line for `forge-topics-mode'.
+Must be set before `forge-topics' is loaded.")
+
+(define-derived-mode forge-topics-mode magit-mode forge-topics-mode-name
+ "Major mode for browsing a list of topics."
+ :interactive nil
+ (magit-hack-dir-local-variables))
+
+(defun forge-topics-setup-buffer (&optional repo spec &rest params)
+ (let* ((global (or (plist-get params :global)
+ (and spec (oref spec global))))
+ (repo (or repo
+ (and (not global)
+ (if-let* ((topic (forge-topic-at-point))
+ (repo (forge-get-repository topic)))
+ repo
+ (forge-get-repository :tracked?)))))
+ (dir (or (and repo (forge-get-worktree repo)) "/"))
+ (buf (forge-topics-buffer-name repo))
+ (buf (or (get-buffer buf) buf))
+ (spec (cond (spec (clone spec))
+ ((and (bufferp buf)
+ (buffer-local-value 'forge--buffer-topics-spec buf)))
+ ((clone forge-list-buffer-default-topic-filters)))))
+ (while-let ((key (pop params)))
+ (eieio-oset spec key (pop params)))
+ (unless (oref spec type)
+ (oset spec type 'topic))
+ (unless (or repo global)
+ (error "Cannot determine repository"))
+ (magit-setup-buffer-internal #'forge-topics-mode nil
+ `((forge-buffer-repository
+ ,(and repo (oref repo id)))
+ (forge--buffer-topics-spec ,spec)
+ (forge-buffer-unassociated-p ,global))
+ (get-buffer-create buf)
+ dir)))
+
+(defun forge-topics-refresh-buffer ()
+ (magit-set-header-line-format (forge-topics-buffer-desc))
+ (let ((topics (forge--list-topics
+ forge--buffer-topics-spec
+ (forge-get-repository :tracked?))))
+ (magit-insert-section (topicbuf)
+ (cond
+ ((not topics)
+ (insert "No matching topics\n"))
+ ((not (oref forge--buffer-topics-spec grouped))
+ (dolist (topic topics)
+ (forge--insert-topic topic 5)))
+ ((pcase-dolist (`(,_ . ,topics)
+ (--group-by (oref it repository) topics))
+ (let ((repo (forge-get-repository (car topics))))
+ (magit-insert-section (forge-repo repo)
+ (magit-insert-heading
+ (concat (propertize (format "%s/%s"
+ (oref repo owner)
+ (oref repo name))
+ 'font-lock-face 'bold)
+ (format " (%s)" (length topics))))
+ (dolist (topic topics)
+ (forge--insert-topic topic 5))))))))))
+
+(defun forge-topics-buffer-desc ()
+ (capitalize (concat (symbol-name (oref forge--buffer-topics-spec type)) "s")))
+
+(defun forge-topics-buffer-name (&optional repo)
+ (if repo
+ (format "*forge-topics: %s*" (oref repo slug))
+ "*forge-topics*"))
+
+;;; Commands
+;;;; Menu
+
+;;;###autoload(autoload 'forge-topics-menu "forge-topics" nil t)
+(transient-define-prefix forge-topics-menu ()
+ "Control list of topics displayed in the current buffer."
+ :transient-suffix t
+ :transient-non-suffix #'transient--do-call
+ :transient-switch-frame nil
+ :refresh-suffixes t
+ :environment #'forge--menu-environment
+ :column-widths forge--topic-menus-column-widths
+ [:hide always ("q" forge-menu-quit-list)]
+ [forge--topic-menus-group
+ ["State"
+ ("a" forge-topics-filter-active)
+ ("o" forge-topics-filter-state-open)
+ ("c" forge-topics-filter-state-completed)
+ ("x" forge-topics-filter-state-unplanned)]
+ ["Status"
+ ("i" forge-topics-filter-status-inbox)
+ ("u" forge-topics-filter-status-unread)
+ ("p" forge-topics-filter-status-pending)
+ ("d" forge-topics-filter-status-done)]
+ ["Type"
+ ("t t" forge-topics-all-types)
+ ("t i" forge-topics-filter-issues)
+ ("t p" forge-topics-filter-pullreqs)]]
+ [forge--lists-group
+ ["Filter "
+ ("-m" forge-topics-filter-milestone)
+ ("-l" forge-topics-filter-labels)
+ ("-x" forge-topics-filter-marks)
+ ("-c" forge-topics-filter-author)
+ ("-a" forge-topics-filter-assignee)
+ ("-r" forge-topics-filter-reviewer)
+ ("-s" forge-topics-filter-saved)]
+ ["Display"
+ ("-O" forge-topics-set-order)
+ ("-L" forge-topics-set-limit)
+ ("-F" forge-topics-ungroup)
+ ("-G" forge-topics-group)
+ ("-S" forge-toggle-display-in-status-buffer)
+ ("-H" forge-toggle-topic-legend)]]
+ [forge--topic-legend-group]
+ (interactive)
+ (cond ((derived-mode-p 'forge-topics-mode 'magit-status-mode)
+ (transient-setup 'forge-topics-menu))
+ ((derived-mode-p 'forge-notifications-mode)
+ (setq this-command 'forge-notifications-menu)
+ (transient-setup 'forge-notifications-menu))
+ ((forge-list-topics))))
+
+(transient-augment-suffix forge-topics-menu
+ :transient #'transient--do-replace
+ :if-not-derived '(forge-notifications-mode forge-repository-list-mode)
+ :inapt-if (lambda () (eq (oref transient--prefix command) 'forge-topics-menu))
+ :inapt-face 'forge-suffix-active)
+
+(defvar-local forge--quit-keep-topic-menu nil)
+
+(defun forge-menu-quit-list ()
+ "From a transient menu, quit the list buffer and the menu.
+
+If quitting the list buffer causes another topic, repository list or
+notification list buffer to become current in the selected window,
+then display the respective menu, otherwise display no menu."
+ (interactive)
+ (let ((keep-topic-menu forge--quit-keep-topic-menu))
+ (when (derived-mode-p 'forge-topic-mode
+ 'forge-topics-mode
+ 'forge-repository-list-mode
+ 'forge-notifications-mode)
+ (kill-local-variable 'forge--quit-keep-topic-menu)
+ (quit-window))
+ (cond ((derived-mode-p 'forge-topic-mode)
+ (setq transient--exitp 'replace)
+ (transient-setup (setq this-command 'forge-topic-menu)))
+ ((derived-mode-p 'forge-topics-mode)
+ (unless keep-topic-menu
+ (setq transient--exitp 'replace)
+ (transient-setup (setq this-command 'forge-topics-menu))))
+ ((derived-mode-p 'forge-repository-list-mode)
+ (setq transient--exitp 'replace)
+ (transient-setup (setq this-command 'forge-repositories-menu)))
+ ((derived-mode-p 'forge-notifications-mode)
+ (setq transient--exitp 'replace)
+ (transient-setup (setq this-command 'forge-notifications-menu)))
+ (t
+ (setq transient--exitp t)
+ (transient--pre-exit)
+ (transient--stack-zap)))))
+
+;;;; List
+
+;;;###autoload(autoload 'forge-list-topics "forge-topics" nil t)
+(transient-define-suffix forge-list-topics (&optional repo)
+ "List topics of the current repository."
+ :description "topics"
+ :inapt-if (lambda () (or (not (forge--get-repository:tracked?))
+ (and (eq major-mode 'forge-topics-mode)
+ (not (oref forge--buffer-topics-spec global)))))
+ :inapt-face (lambda () (if (not (forge--get-repository:tracked?))
+ 'transient-inapt-suffix
+ 'forge-suffix-active))
+ (declare (interactive-only nil))
+ (interactive)
+ (forge-topics-setup-buffer repo)
+ (transient-setup 'forge-topics-menu))
+
+;;;###autoload(autoload 'forge-list-issues "forge-topics" nil t)
+(transient-define-suffix forge-list-issues (&optional repo)
+ "List issues of the current repository."
+ :description "issues"
+ (declare (interactive-only nil))
+ (interactive)
+ (forge-topics-setup-buffer repo nil :type 'issue)
+ (transient-setup 'forge-topics-menu))
+
+;;;###autoload(autoload 'forge-list-pullreqs "forge-topics" nil t)
+(transient-define-suffix forge-list-pullreqs (&optional repo)
+ "List pull-requests of the current repository."
+ :description "pull-requests"
+ (declare (interactive-only nil))
+ (interactive)
+ (forge-topics-setup-buffer repo nil :type 'pullreq)
+ (transient-setup 'forge-topics-menu))
+
+;;;###autoload(autoload 'forge-list-global-topics "forge-topics" nil t)
+(transient-define-suffix forge-list-global-topics (&optional repo)
+ "List topics across all tracked repository."
+ :description "topics"
+ :inapt-if (lambda () (and (eq major-mode 'forge-topics-mode)
+ (oref forge--buffer-topics-spec global)))
+ :inapt-face 'forge-suffix-active
+ (declare (interactive-only nil))
+ (interactive)
+ (forge-topics-setup-buffer repo nil :global t)
+ (transient-setup 'forge-topics-menu))
+
+;;;###autoload(autoload 'forge-list-global-issues "forge-topics" nil t)
+(transient-define-suffix forge-list-global-issues (&optional repo)
+ "List issues across all tracked repository."
+ :description "issues"
+ (declare (interactive-only nil))
+ (interactive)
+ (forge-topics-setup-buffer repo nil :global t :type 'issue)
+ (transient-setup 'forge-topics-menu))
+
+;;;###autoload(autoload 'forge-list-global-pullreqs "forge-topics" nil t)
+(transient-define-suffix forge-list-global-pullreqs (&optional repo)
+ "List pull-requests across all tracked repository."
+ :description "pull-requests"
+ (declare (interactive-only nil))
+ (interactive)
+ (forge-topics-setup-buffer repo nil :global t :type 'pullreq)
+ (transient-setup 'forge-topics-menu))
+
+;;;; Type
+
+(defclass forge--topics-filter-type-command (transient-suffix)
+ ((type :initarg :type)
+ (definition
+ :initform (lambda (&optional repo)
+ (interactive)
+ (oset forge--buffer-topics-spec type
+ (oref (transient-suffix-object) type))
+ (forge-refresh-buffer)))
+ (inapt-face :initform 'forge-suffix-active)
+ (inapt-if
+ :initform (lambda ()
+ (eq (oref forge--buffer-topics-spec type)
+ (oref (transient-suffix-object) type))))))
+
+(transient-define-suffix forge-topics-all-types ()
+ :class 'forge--topics-filter-type-command :type 'topic
+ :description "topics")
+
+(transient-define-suffix forge-topics-filter-issues ()
+ "List issues of the current repository."
+ :class 'forge--topics-filter-type-command :type 'issue
+ :description "issues")
+
+(transient-define-suffix forge-topics-filter-pullreqs ()
+ "List pull-requests of the current repository."
+ :class 'forge--topics-filter-type-command :type 'pullreq
+ :description "pull-requests")
+
+;;;; Active
+
+(transient-define-suffix forge-topics-filter-active ()
+ "Limit topic list to active topics."
+ :description "active"
+ :face (lambda ()
+ (and (oref forge--buffer-topics-spec active)
+ 'forge-suffix-active))
+ (interactive)
+ (oset forge--buffer-topics-spec active
+ (not (oref forge--buffer-topics-spec active)))
+ (forge-refresh-buffer))
+
+;;;; State
+
+(defclass forge--topics-filter-state-command (transient-suffix)
+ ((state :initarg :state)
+ (definition
+ :initform (lambda ()
+ (interactive)
+ (let ((want (oref (transient-suffix-object) state))
+ (spec forge--buffer-topics-spec))
+ (cond ((and (eq want 'open)
+ (oref spec active))
+ (oset spec active nil)
+ (oset spec state want))
+ ((equal (oref spec state) want)
+ (oset spec state nil))
+ (t
+ (oset spec active nil)
+ (oset spec state want))))
+ (forge-refresh-buffer)))
+ (description
+ :initform (lambda (suffix)
+ (let ((want (oref suffix state))
+ (type (oref forge--buffer-topics-spec type)))
+ (pcase type
+ ((guard (atom want))
+ (symbol-name want))
+ ('topic (apply #'format "%s/%s" want))
+ ('issue (symbol-name (car want)))
+ ('pullreq (symbol-name (cadr want)))))))
+ (face
+ :initform (lambda (suffix)
+ (let ((want (oref suffix state))
+ (have (oref forge--buffer-topics-spec state))
+ (active (oref forge--buffer-topics-spec active)))
+ (cond ((and (not active)
+ (equal have want))
+ 'forge-suffix-active)
+ ((and (or active
+ (eq have 'open))
+ (eq want 'open))
+ (if (eq have want)
+ 'forge-suffix-active-and-implied
+ 'forge-suffix-implied))))))))
+
+(transient-define-suffix forge-topics-filter-state-open ()
+ "Limit topic list to open topics."
+ :class 'forge--topics-filter-state-command :state 'open)
+
+(transient-define-suffix forge-topics-filter-state-completed ()
+ "Limit topic list to completed and merged topics."
+ :class 'forge--topics-filter-state-command :state '(completed merged))
+
+(transient-define-suffix forge-topics-filter-state-unplanned ()
+ "Limit topic list to unplanned and rejected topics."
+ :class 'forge--topics-filter-state-command :state '(unplanned rejected))
+
+;;;; Status
+
+(defclass forge--topics-filter-status-command (transient-suffix)
+ ((status :initarg :status)
+ (definition
+ :initform (lambda ()
+ (interactive)
+ (let* ((want (oref (transient-suffix-object) status))
+ (spec forge--buffer-topics-spec)
+ (have (oref spec status))
+ (active (oref spec active)))
+ (cond (active
+ (oset spec active nil)
+ (oset spec status want))
+ ((eq have want)
+ (oset spec status nil))
+ ((oset spec status want))))
+ (forge-refresh-buffer)))
+ (description
+ :initform (lambda (suffix) (symbol-name (oref suffix status))))
+ (face
+ :initform (lambda (suffix)
+ (let ((want (oref suffix status))
+ (have (oref forge--buffer-topics-spec status))
+ (active (oref forge--buffer-topics-spec active)))
+ (cond ((and (not active)
+ (equal have want))
+ 'forge-suffix-active)
+ ((and (or active
+ (eq have 'inbox))
+ (memq want '(inbox unread pending)))
+ (if (eq have want)
+ 'forge-suffix-active-and-implied
+ 'forge-suffix-implied))))))))
+
+(transient-define-suffix forge-topics-filter-status-inbox ()
+ "Limit topic list to unread and pending topics."
+ :class 'forge--topics-filter-status-command :status 'inbox)
+
+(transient-define-suffix forge-topics-filter-status-unread ()
+ "Limit topic list to unread topics."
+ :class 'forge--topics-filter-status-command :status 'unread)
+
+(transient-define-suffix forge-topics-filter-status-pending ()
+ "Limit topic list to pending topics."
+ :class 'forge--topics-filter-status-command :status 'pending)
+
+(transient-define-suffix forge-topics-filter-status-done ()
+ "Limit topic list to done topics."
+ :class 'forge--topics-filter-status-command :status 'done)
+
+;;;; Filter
+
+(defclass forge--topics-filter-command (transient-suffix)
+ ((slot :initarg :slot)
+ (reader :initarg :reader)
+ (formatter :initarg :formatter :initform nil)
+ (definition
+ :initform (lambda ()
+ (interactive)
+ (with-slots (slot reader) (transient-suffix-object)
+ (eieio-oset forge--buffer-topics-spec slot
+ (if (eieio-oref forge--buffer-topics-spec slot)
+ nil
+ (funcall reader)))
+ (forge-refresh-buffer))))
+ (description
+ :initform (lambda (obj)
+ (with-slots (slot formatter) obj
+ (let ((value (eieio-oref forge--buffer-topics-spec slot)))
+ (if value
+ (format "%s %s" slot
+ (if formatter
+ (funcall formatter value)
+ (propertize (format "%s" value)
+ 'face 'forge-suffix-active)))
+ (format "%s" slot))))))))
+
+(cl-defmethod initialize-instance :after
+ ((obj forge--topics-filter-command) &optional _slots)
+ (unless (slot-boundp obj 'reader)
+ (oset obj reader (intern (format "forge-read-topic-%s" (oref obj slot))))))
+
+(transient-define-suffix forge-topics-filter-milestone ()
+ "Read a milestone and limit topic list to topics with that milestone."
+ :class 'forge--topics-filter-command
+ :slot 'milestone
+ :formatter (lambda (m) (propertize m 'face 'forge-topic-label)))
+
+(transient-define-suffix forge-topics-filter-labels ()
+ "Read labels and limit topic list to topics with one of these labels."
+ :class 'forge--topics-filter-command
+ :slot 'labels
+ :formatter (lambda (labels) (and labels (forge--format-labels labels " "))))
+
+(transient-define-suffix forge-topics-filter-marks ()
+ "Read marks and limit topic list to topics with one of these marks."
+ :class 'forge--topics-filter-command
+ :slot 'marks
+ :formatter (lambda (marks) (and marks (forge--format-marks marks " "))))
+
+(transient-define-suffix forge-topics-filter-saved ()
+ "Toggle whether to limit topic list to saved topics."
+ :class 'forge--topics-filter-command
+ :slot 'saved
+ :reader #'always
+ :description
+ (lambda () (forge--format-boolean 'saved "saved" forge--buffer-topics-spec)))
+
+(transient-define-suffix forge-topics-filter-author ()
+ "Read an author and limit topic list to topics created by that author."
+ :class 'forge--topics-filter-command
+ :slot 'author
+ :reader (lambda () (forge--read-filter-by-user "Author")))
+
+(transient-define-suffix forge-topics-filter-assignee ()
+ "Read an assignee and limit topic list to topics assignee to that person."
+ :class 'forge--topics-filter-command
+ :slot 'assignee
+ :reader (lambda () (forge--read-filter-by-user "Assignee")))
+
+(transient-define-suffix forge-topics-filter-reviewer ()
+ "Read a reviewer and limit topic list to reviews requested from that person."
+ :class 'forge--topics-filter-command
+ :slot 'reviewer
+ :reader (lambda () (forge--read-filter-by-user "Reviewer")))
+
+(defun forge--read-filter-by-user (prompt)
+ (let* ((repo (forge-get-repository :tracked))
+ (choices (mapcar #'cadr (oref repo assignees))))
+ (magit-completing-read prompt choices)))
+
+;;;; Display
+
+(transient-define-suffix forge-topics-set-order (order)
+ "Select order used to display topics in topic list."
+ :description
+ (lambda ()
+ (format "order by %s"
+ (propertize (format "%s" (oref forge--buffer-topics-spec order))
+ 'face 'bold)))
+ (interactive
+ (list (magit-read-char-case "Order by: " t
+ (?n "[n]ewest" 'newest)
+ (?o "[o]ldest" 'oldest)
+ (?u "[r]ecently updated" 'recently-updated)
+ (?U "[a]nciently updated" 'anciently-updated))))
+ (oset forge--buffer-topics-spec order order)
+ (forge-refresh-buffer))
+
+(transient-define-suffix forge-topics-set-limit (limit)
+ "Read maximal number of topics to be displayed in topic list."
+ :description
+ (lambda ()
+ (if-let ((limit (oref forge--buffer-topics-spec limit)))
+ (format "limit to %s" (propertize (format "%s" limit) 'face 'bold))
+ "no limit"))
+ (interactive (list (read-number "Limit number (0 for no limit): ")))
+ (oset forge--buffer-topics-spec limit (if (zerop limit) nil limit))
+ (forge-refresh-buffer))
+
+(transient-define-suffix forge-topics-group ()
+ "Group topics by repository."
+ :description "group by repo"
+ :if (lambda () (oref forge--buffer-topics-spec global))
+ :inapt-if (lambda () (oref forge--buffer-topics-spec grouped))
+ :inapt-face 'forge-suffix-active
+ (interactive)
+ (oset forge--buffer-topics-spec grouped t)
+ (forge-refresh-buffer))
+
+(transient-define-suffix forge-topics-ungroup ()
+ "Show a flat topic list."
+ :description "single list"
+ :if (lambda () (oref forge--buffer-topics-spec global))
+ :inapt-if-not (lambda () (oref forge--buffer-topics-spec grouped))
+ :inapt-face 'forge-suffix-active
+ (interactive)
+ (oset forge--buffer-topics-spec grouped nil)
+ (forge-refresh-buffer))
+
+;;; _
+(provide 'forge-topics)
+;;; forge-topics.el ends here
--- /dev/null
+;;; forge.el --- Access Git forges from Magit -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018-2024 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.forgeNOSPAMjonas.bernoulli.dev>
+;; Homepage: https://github.com/magit/forge
+;; Keywords: git tools vc
+
+;; Package-Version: 20241223.1032
+;; Package-Revision: 8bace81bce39
+;; Package-Requires: (
+;; (emacs "29.1")
+;; (compat "30.0.0.0")
+;; (closql "2.1.0")
+;; (dash "2.19.1")
+;; (emacsql "4.1.0")
+;; (ghub "4.2.0")
+;; (let-alist "1.0.6")
+;; (magit "4.1.3")
+;; (markdown-mode "2.6")
+;; (seq "2.24")
+;; (transient "0.8.0")
+;; (yaml "0.5.5"))
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Work with Git forges, such as Github and Gitlab, from the comfort
+;; of Magit and the rest of Emacs.
+
+;; The schema of the database has not been finalized yet. Until that
+;; has happened it will occasionally have to be discarded. For now
+;; the database does not contain any information that cannot simply
+;; be fetched again.
+
+;;; Code:
+
+(require 'magit)
+
+(require 'forge-db)
+(require 'forge-core)
+
+(provide 'forge)
+
+(require 'forge-repo)
+(require 'forge-post)
+(require 'forge-topic)
+(require 'forge-issue)
+(require 'forge-pullreq)
+(require 'forge-revnote)
+(require 'forge-notify)
+
+(require 'forge-github)
+(require 'forge-gitlab)
+(require 'forge-gitea)
+(require 'forge-gogs)
+(require 'forge-bitbucket)
+(require 'forge-semi)
+
+(require 'forge-commands)
+(require 'forge-topics)
+(require 'forge-repos)
+
+;;; Add Sections
+
+(defvar forge-add-default-sections t
+ "Whether to add Forge's sections to `magit-status-sections-hook'.
+
+If you want to disable this, then you must set this to nil before
+`forge' is loaded.")
+
+(when forge-add-default-sections
+ (magit-add-section-hook 'magit-status-sections-hook #'forge-insert-pullreqs nil t)
+ (magit-add-section-hook 'magit-status-sections-hook #'forge-insert-issues nil t))
+
+;;; Add Bindings
+
+;;;###autoload
+(defvar forge-add-default-bindings t
+ "Whether to add Forge's bindings to various Magit keymaps.
+
+If you want to disable this, then you must set this to nil before
+`magit' is loaded. If you do it before `forge' but after `magit'
+is loaded, then `magit-mode-map' ends up being modified anyway.")
+
+;;;###autoload
+(with-eval-after-load 'magit-mode
+ (when forge-add-default-bindings
+ (keymap-set magit-mode-map "'" #'forge-dispatch)
+ (keymap-set magit-mode-map "N" #'forge-dispatch)
+ (keymap-set magit-mode-map "<remap> <magit-browse-thing>"
+ #'forge-browse)
+ (keymap-set magit-mode-map "<remap> <magit-copy-thing>"
+ #'forge-copy-url-at-point-as-kill)))
+
+;;;###autoload
+(with-eval-after-load 'magit-repos
+ (when forge-add-default-bindings
+ (keymap-set magit-repolist-mode-map "N" #'forge-dispatch)))
+
+;;;###autoload
+(with-eval-after-load 'git-commit
+ (when forge-add-default-bindings
+ (keymap-set git-commit-mode-map "C-c C-v" #'forge-visit-topic)))
+
+(when forge-add-default-bindings
+ (keymap-set magit-commit-section-map "C-c C-v" #'forge-visit-topic)
+ (keymap-set magit-branch-section-map "C-c C-v" #'forge-visit-topic)
+
+ (transient-insert-suffix 'magit-dispatch "o"
+ '("N" "Forge" forge-dispatch))
+
+ (transient-append-suffix 'magit-fetch "m" '("n" forge-pull))
+ (transient-append-suffix 'magit-fetch "n" '("N" forge-pull-notifications))
+
+ (transient-append-suffix 'magit-pull "m" '("n" forge-pull))
+ (transient-append-suffix 'magit-pull "n" '("N" forge-pull-notifications))
+
+ (transient-append-suffix 'magit-branch "w"
+ '("f" "pull-request" forge-checkout-pullreq))
+ (transient-append-suffix 'magit-branch "W"
+ '("F" "from pull-request" forge-branch-pullreq))
+
+ (transient-suffix-put 'magit-remote 'magit-update-default-branch :key "b u")
+ (transient-append-suffix 'magit-remote "b u"
+ '("b r" "Rename default branch" forge-rename-default-branch))
+
+ (transient-append-suffix 'magit-worktree "c"
+ '("n" "pull-request worktree" forge-checkout-worktree))
+
+ (transient-append-suffix 'magit-status-jump "w"
+ '("Np" "Pull requests" forge-jump-to-pullreqs))
+ (transient-append-suffix 'magit-status-jump "Np"
+ '("Ni" "Issues" forge-jump-to-issues))
+
+ (transient-append-suffix 'magit-merge "a"
+ '(7 "M" "Merge using API" forge-merge)))
+
+;;; Startup Asserts
+
+(defconst forge--minimal-git "2.7.0")
+
+(defun forge-startup-asserts ()
+ (let ((version (magit-git-version)))
+ (when (and version (version< version forge--minimal-git))
+ (display-warning 'magit (format "\
+Forge requires Git >= %s, you are using %s.
+
+If this comes as a surprise to you, because you do actually have
+a newer version installed, then that probably means that the
+older version happens to appear earlier on the `$PATH'. If you
+always start Emacs from a shell, then that can be fixed in the
+shell's init file. If you start Emacs by clicking on an icon,
+or using some sort of application launcher, then you probably
+have to adjust the environment as seen by graphical interface.
+For X11 something like ~/.xinitrc should work.
+
+If you use Tramp to work inside remote Git repositories, then you
+have to make sure a suitable Git is used on the remote machines
+too.\n" forge--minimal-git version) :error))))
+
+(if after-init-time
+ (forge-startup-asserts)
+ (add-hook 'after-init-hook #'forge-startup-asserts t))
+
+;;; forge.el ends here
--- /dev/null
+This is forge.info, produced by makeinfo version 6.8 from forge.texi.
+
+ Copyright (C) 2018-2024 Jonas Bernoulli
+ <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+ You can redistribute this document and/or modify it under the terms
+ of the GNU General Public License as published by the Free Software
+ Foundation, either version 3 of the License, or (at your option)
+ any later version.
+
+ This document is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+INFO-DIR-SECTION Emacs
+START-INFO-DIR-ENTRY
+* Forge: (forge). Access Git Forges from Magit.
+END-INFO-DIR-ENTRY
+
+\1f
+File: forge.info, Node: Top, Next: Introduction, Up: (dir)
+
+Forge User and Developer Manual
+*******************************
+
+Forge allows you to work with Git forges, currently Github and Gitlab,
+from the comfort of Magit and Emacs.
+
+This manual is for Forge version 0.4.5.
+
+ Copyright (C) 2018-2024 Jonas Bernoulli
+ <emacs.forgeNOSPAMjonas.bernoulli.dev>
+
+ You can redistribute this document and/or modify it under the terms
+ of the GNU General Public License as published by the Free Software
+ Foundation, either version 3 of the License, or (at your option)
+ any later version.
+
+ This document is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+* Menu:
+
+* Introduction::
+* Initial Setup::
+* Initial Pull::
+* Getting Started::
+* Lists and Menus::
+* Visiting Topics::
+* Creating Topics and Posts::
+* Editing Topics::
+* Pulling::
+* Branching::
+* Miscellaneous Commands::
+* Miscellaneous Options::
+* How Forge Detection Works::
+* Supported Forges and Hosts::
+* FAQ::
+* Keystroke Index::
+* Function and Command Index::
+* Variable Index::
+
+— The Detailed Node Listing —
+
+Initial Setup
+
+* Setup for Github.com: Setup for Githubcom.
+* Setup for Another Github Instance::
+* Setup for Gitlab.com: Setup for Gitlabcom.
+* Setup for Another Gitlab Instance::
+* Setup a Partially Supported Host::
+
+Supported Forges and Hosts
+
+* Supported Forges::
+* Partially Supported Forges::
+* Supported Semi-Forges::
+
+FAQ
+
+* ‘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: Initial Setup, Prev: Top, Up: Top
+
+1 Introduction
+**************
+
+Forge allows you to work with Git forges, currently Github and Gitlab,
+from the comfort of Magit and Emacs.
+
+ Forge fetches issues, pull-requests and other data using the forge’s
+API and stores the retrieved information in a local database.
+Additionally it fetches pull-request references using Git.
+
+\1f
+File: forge.info, Node: Initial Setup, Next: Initial Pull, Prev: Introduction, Up: Top
+
+2 Initial Setup
+***************
+
+Please first do the common setup below and then carefully follow the
+instructions for your forge instance. Once you have completed the
+setup, you can start tracking repositories (see *note Initial Pull::).
+
+ If you run into difficulties during setup or the initial pull, then
+please also see *note How Forge Detection Works:: and *note
+(ghub)Getting Started::.
+
+* Menu:
+
+* Setup for Github.com: Setup for Githubcom.
+* Setup for Another Github Instance::
+* Setup for Gitlab.com: Setup for Gitlabcom.
+* Setup for Another Gitlab Instance::
+* Setup a Partially Supported Host::
+
+Common Setup
+============
+
+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)
+
+ By default Forge adds some bindings to Magit keymaps and menus, and
+some sections to Magit buffers. If you would like to prevent that, you
+have to set ‘forge-add-default-bindings’ and/or
+‘forge-add-default-sections’ to ‘nil’, before ‘magit’ (not just ‘forge’)
+is loaded.
+
+\1f
+File: forge.info, Node: Setup for Githubcom, Next: Setup for Another Github Instance, Up: Initial Setup
+
+2.1 Setup for Github.com
+========================
+
+Set your Username
+-----------------
+
+First inform Forge about your <https://github.com> username:
+
+ git config --global github.user USERNAME
+
+ If you need to identify as another user in a particular repository,
+then you have to set that variable locally:
+
+ cd /path/to/repo
+ git config --local github.user USERNAME
+
+Create and Store an Access Token
+--------------------------------
+
+Visit <https://github.com/settings/tokens> in a browser to generate a
+new "classic" token using the ‘repo’, ‘user’ and ‘read:org’ scopes. Do
+not close the browser window just yet, because the token will only be
+shown once.
+
+ The built-in Auth-Source (*note (auth)Top::) package is used to store
+the token generated in the previous step. The ‘auth-sources’ variable
+controls how and where Auth-Source keeps its secrets. The default value
+is a list of three files: ‘("~/.authinfo" "~/.authinfo.gpg"
+"~/.netrc")’, but that can lead to confusing behavior, so you should
+make sure that only one of these files exists, and then you should also
+adjust the value of the variable to only ever use that file, for
+example:
+
+ (setq auth-sources '("~/.authinfo"))
+
+ In ‘~/.authinfo’ secrets are stored in plain text. If you don’t want
+that, then you should use the encrypted ‘~/.authinfo.gpg’ instead:
+
+ (setq auth-sources '("~/.authinfo.gpg"))
+
+ Make sure you put one of these forms in your init file *and* to
+evaluate it in the current Emacs instance as well, by placing the cursor
+after the final closing parenthesis and typing ‘C-x C-e’
+(‘eval-last-sexp’).
+
+ Next add a line like the following to the chosen file:
+
+ machine api.github.com login USERNAME^forge password TOKEN
+
+ • The value of ‘machine’ must be ‘api.github.com’. Variations of
+ this won’t work.
+
+ • USERNAME must be the same as the value used for the ‘github.user’
+ Git variable above. You *must* append ‘^forge’ to that, without
+ any space in between.
+
+ • TOKEN is the token you generated earlier.
+
+ Finish by typing ‘M-x auth-source-forget-all-cached RET’. If you
+don’t do this, then Auth-Source may fail to look up the token.
+
+\1f
+File: forge.info, Node: Setup for Another Github Instance, Next: Setup for Gitlabcom, Prev: Setup for Githubcom, Up: Initial Setup
+
+2.2 Setup for Another Github Instance
+=====================================
+
+Before you setup a Github instance that is not <https://github.com>,
+please set that up first. The setup for <https://github.com> is easier
+and if that works, but the setup for the other Github instance fails,
+then we can tentatively narrow the issue down to the parts that differ
+between <https://github.com> and other instances.
+
+Tell Forge about the Instance
+-----------------------------
+
+While Forge knows about <https://github.com>, it does not know about
+your other Github instances. Forge instances are configured using the
+option ‘forge-alist’ (also see its docstring). The entry for
+<https://github.com> in that variable looks like this:
+
+ ("github.com" ; GITHOST
+ "api.github.com" ; APIHOST
+ "github.com" ; WEBHOST and INSTANCE-ID
+ forge-github-repository) ; CLASS
+
+ You have to add an entry for your instance. For example, assuming
+you company uses <https://example.com>, this might be correct:
+
+ (push '("example.com" ; GITHOST
+ "api.example.com" ; APIHOST
+ "example.com" ; WEBHOST and INSTANCE-ID
+ forge-github-repository) ; CLASS
+ forge-alist)
+
+ Your company may use hostnames that follow a different format. You
+should be able to easily determine and verify GITHOST and WEBHOST, but
+determining APIHOST is more difficult; you might have to ask a coworker.
+APIHOST could be something like ‘api.example.com’, but it could also be
+something like ‘example.com/api’.
+
+ If the REST API’s end point is ‘/v3’ and the GraphQL API’s end point
+is ‘/graphql’, then use something like ‘example.com/v3’ as APIHOST.
+This is a historic accident. See
+<https://github.com/magit/forge/issues/174>.
+
+ We will use INSTANCE-ID (aka WEBHOST) and APIHOST below.
+
+Set your Username
+-----------------
+
+Inform Forge about your username for the Github instance in question:
+
+ git config --global github.INSTANCE-ID.user USERNAME
+
+ So if INSTANCE-ID is ‘example.com’ and USERNAME is ‘tarsius’ then
+use:
+
+ git config --global github.example.com.user tarsius
+
+Create and Store an Access Token
+--------------------------------
+
+Visit your forge in a browser. Follow a link to "Settings", from there
+to "Developer settings", from there to "Personal access tokens", and
+finally to "Tokens (classic)". On that page generate a new token using
+the ‘repo’, ‘user’ and ‘read:org’ scopes. Do not close the browser
+window just yet, because the token will only be shown once.
+
+ The built-in Auth-Source (*note (auth)Top::) package is used to store
+the token generated in the previous step. The ‘auth-sources’ variable
+controls how and where Auth-Source keeps its secrets. The default value
+is a list of three files: ‘("~/.authinfo" "~/.authinfo.gpg"
+"~/.netrc")’, but that can lead to confusing behavior, so you should
+make sure that only one of these files exists, and then you should also
+adjust the value of the variable to only ever use that file, for
+example:
+
+ (setq auth-sources '("~/.authinfo"))
+
+ In ‘~/.authinfo’ secrets are stored in plain text. If you don’t want
+that, then you should use the encrypted ‘~/.authinfo.gpg’ instead:
+
+ (setq auth-sources '("~/.authinfo.gpg"))
+
+ Make sure you put one of these forms in your init file *and* to
+evaluate it in the current Emacs instance as well, by placing the cursor
+after the final closing parenthesis and typing ‘C-x C-e’
+(‘eval-last-sexp’).
+
+ Next add a line like the following to the chosen file:
+
+ machine APIHOST login USERNAME^forge password TOKEN
+
+ • APIHOST must be the same as the second element of the entry we
+ added to ‘forge-alist’. In the above example that would be
+ ‘api.example.com’. Do *not* instead use GITHOST or INSTANCE-ID
+ (aka WEBHOST).
+
+ • USERNAME must be the same username you used above as the value of
+ the Git variable. You *must* append ‘^forge’ to that, without any
+ space in between.
+
+ • TOKEN is the token you generated earlier.
+
+ Finish by typing ‘M-x auth-source-forget-all-cached RET’. If you
+don’t do this, then Auth-Source may fail to look up the token.
+
+\1f
+File: forge.info, Node: Setup for Gitlabcom, Next: Setup for Another Gitlab Instance, Prev: Setup for Another Github Instance, Up: Initial Setup
+
+2.3 Setup for Gitlab.com
+========================
+
+Set your Username
+-----------------
+
+First inform Forge about your <https://gitlab.com> username:
+
+ git config --global gitlab.user USERNAME
+
+ If you need to identify as another user in a particular repository,
+then you have to set that variable locally:
+
+ cd /path/to/repo
+ git config --local gitlab.user USERNAME
+
+Create and Store an Access Token
+--------------------------------
+
+Visit <https://gitlab.com/-/user_settings/personal_access_tokens> in a
+browser to generate a new token using the ‘api’, ‘read_api’ and
+‘read_user’ scopes. Do not close the browser window just yet, because
+the token will only be shown once.
+
+ The built-in Auth-Source (*note (auth)Top::) package is used to store
+the token generated in the previous step. The ‘auth-sources’ variable
+controls how and where Auth-Source keeps its secrets. The default value
+is a list of three files: ‘("~/.authinfo" "~/.authinfo.gpg"
+"~/.netrc")’, but that can lead to confusing behavior, so you should
+make sure that only one of these files exists, and then you should also
+adjust the value of the variable to only ever use that file, for
+example:
+
+ (setq auth-sources '("~/.authinfo"))
+
+ In ‘~/.authinfo’ secrets are stored in plain text. If you don’t want
+that, then you should use the encrypted ‘~/.authinfo.gpg’ instead:
+
+ (setq auth-sources '("~/.authinfo.gpg"))
+
+ Make sure you put one of these forms in your init file *and* to
+evaluate it in the current Emacs instance as well, by placing the cursor
+after the final closing parenthesis and typing ‘C-x C-e’
+(‘eval-last-sexp’).
+
+ Next add a line like the following to the chosen file:
+
+ machine gitlab.com/api/v4 login USERNAME^forge password TOKEN
+
+ • The value of ‘machine’ must be ‘gitlab.com/api/v4’. Variations of
+ this won’t work.
+
+ • USERNAME must be the same as the value used for the ‘gitlab.user’
+ Git variable above. You *must* append ‘^forge’ to that, without
+ any space in between.
+
+ • TOKEN is the token you generated earlier.
+
+ Finish by typing ‘M-x auth-source-forget-all-cached RET’. If you
+don’t do this, then Auth-Source may fail to look up the token.
+
+\1f
+File: forge.info, Node: Setup for Another Gitlab Instance, Next: Setup a Partially Supported Host, Prev: Setup for Gitlabcom, Up: Initial Setup
+
+2.4 Setup for Another Gitlab Instance
+=====================================
+
+Before you setup a Gitlab instance that is not <https://gitlab.com>,
+please set that up first. The setup for <https://gitlab.com> is easier
+and if that works, but the setup for the other Gitlab instance fails,
+then we can tentatively narrow the issue down to the parts that differ
+between <https://gitlab.com> and other instances.
+
+Tell Forge about the Instance
+-----------------------------
+
+While Forge knows about <https://gitlab.com> (and a few other well-known
+instances, see its value) it has to be taught about other Gitlab
+instances. Forge instances are configured using the option
+‘forge-alist’ (also see its docstring). The entry for
+<https://gitlab.com> in that variable looks like this:
+
+ ("gitlab.com" ; GITHOST
+ "gitlab.com/api/v4" ; APIHOST
+ "gitlab.com" ; WEBHOST and INSTANCE-ID
+ forge-gitlab-repository) ; CLASS
+
+ For historic reasons, APIHOST actually has to be a host followed by a
+path.
+
+ You have to add an entry for your instance. For example, assuming
+you company/organisation uses <https://example.com>, this might be
+correct:
+
+ (push '("example.com" ; GITHOST
+ "example.com/api/v4" ; APIHOST
+ "example.com" ; WEBHOST and INSTANCE-ID
+ forge-gitlab-repository) ; CLASS
+ forge-alist)
+
+ Your company may use hostnames that follow a different format. You
+should be able to easily determine and verify GITHOST and WEBHOST, but
+determining APIHOST is more difficult; you might have to ask a
+colleague.
+
+ We will use INSTANCE-ID (aka WEBHOST) and APIHOST below.
+
+Set your Username
+-----------------
+
+Inform Forge about your username for the Gitlab instance in question:
+
+ git config --global gitlab.INSTANCE-ID.user USERNAME
+
+ So if INSTANCE-ID is ‘example.com’ and USERNAME is ‘tarsius’ then
+use:
+
+ git config --global gitlab.example.com.user tarsius
+
+Create and Store an Access Token
+--------------------------------
+
+Visit your forge in a browser. Follow a link to "Preferences" and from
+there to "Access Tokens". On that page generate a new "Personal access
+token" using the ‘api’, ‘read_api’ and ‘read_user’ scopes. Do not close
+the browser window just yet, because the token will only be shown once.
+
+ The built-in Auth-Source (*note (auth)Top::) package is used to store
+the token generated in the previous step. The ‘auth-sources’ variable
+controls how and where Auth-Source keeps its secrets. The default value
+is a list of three files: ‘("~/.authinfo" "~/.authinfo.gpg"
+"~/.netrc")’, but that can lead to confusing behavior, so you should
+make sure that only one of these files exists, and then you should also
+adjust the value of the variable to only ever use that file, for
+example:
+
+ (setq auth-sources '("~/.authinfo"))
+
+ In ‘~/.authinfo’ secrets are stored in plain text. If you don’t want
+that, then you should use the encrypted ‘~/.authinfo.gpg’ instead:
+
+ (setq auth-sources '("~/.authinfo.gpg"))
+
+ Make sure you put one of these forms in your init file *and* to
+evaluate it in the current Emacs instance as well, by placing the cursor
+after the final closing parenthesis and typing ‘C-x C-e’
+(‘eval-last-sexp’).
+
+ Next add a line like the following to the chosen file:
+
+ machine APIHOST login USERNAME^forge password TOKEN
+
+ • APIHOST must be the same as the second element of the entry we
+ added to ‘forge-alist’. In the above example that would be
+ ‘example.com/api/v4’. Do *not* instead use GITHOST or INSTANCE-ID
+ (aka WEBHOST).
+
+ • USERNAME must be the same username you used above as the value of
+ the Git variable. You *must* append ‘^forge’ to that, without any
+ space in between.
+
+ • TOKEN is the token you generated earlier.
+
+ Finish by typing ‘M-x auth-source-forget-all-cached RET’. If you
+don’t do this, then Auth-Source may fail to look up the token.
+
+\1f
+File: forge.info, Node: Setup a Partially Supported Host, Prev: Setup for Another Gitlab Instance, Up: Initial Setup
+
+2.5 Setup a Partially Supported Host
+====================================
+
+Forge currently only supports the Github and Gitlab APIs.
+
+ It does however partially support a few additional forge types (see
+*note Partially Supported Forges::) and other lighter weight software
+used to host Git repositories, which also provide a web interfaces (see
+*note Supported Semi-Forges::). Forge doesn’t use the APIs of such
+forges, but registering the host and adding repositories to the local
+database at least enables the use of commands such as ‘forge-browse’.
+
+Tell Forge about the Instance
+-----------------------------
+
+A few hosts, which use partially supported forge types, are available
+out-of-the-box, because they have an entry in the default value of
+option ‘forge-alist’ (also see its docstring). For example, the entry
+for <https://github.com> in that variable looks like this:
+
+ ("codeberg.org" ; GITHOST
+ "codeberg.org/api/v1" ; APIHOST
+ "codeberg.org" ; WEBHOST and INSTANCE-ID
+ forge-gitea-repository) ; CLASS
+
+ To be able to add repositories from a, so far, unknown forge instance
+to your local database, you have to add an entry for that instance to
+‘forge-alist’. For example, assuming you use another Gitea instance,
+hosted at <https://example.com>, this might be correct:
+
+ (push '("example.com" ; GITHOST
+ "example.com/api/v1" ; APIHOST
+ "example.com" ; WEBHOST and INSTANCE-ID
+ forge-gitea-repository) ; CLASS
+ forge-alist)
+
+ Look at ‘forge-alist’ entries of other hosts using the same forge
+type as the instance you are configuring, to see what format *might* be
+appropriate. You should be able to easily determine and verify GITHOST
+and WEBHOST, but determining APIHOST is more difficult; you might have
+to ask a colleague. APIHOST could be something like
+‘example.com/api/vi’, but it could also be something like
+‘api.example.com’.
+
+Add Support for Additional Forge Types
+--------------------------------------
+
+For each fully or partially supported forge type, Forge defines at least
+a class. The following example is taken from ‘forge-semi.el’:
+
+ (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\".")
+
+ Once you add a host using that class to ‘forge-alist’ and then a
+repository from that host to the local database, you will be able to use
+commands such as ‘forge-browse-branch’ (but not much more).
+
+ If you want to add a repository from another host, which happens to
+use another software or another URL schemata, then you might have to
+define an additional class first. See ‘forge-semi.el’ for simple
+examples and grep for ‘defclass forge-.*-repository’ for more complex
+ones.
+
+\1f
+File: forge.info, Node: Initial Pull, Next: Getting Started, Prev: Initial Setup, Up: Top
+
+3 Initial Pull
+**************
+
+To start using Forge in a certain repository, visit the Magit status
+buffer for that repository and type ‘N / a’ (‘forge-add-repository’).
+You are given a choice to pull all topics, all topics that were updated
+after a certain date, or only individual topics.
+
+ Beside adding the repository to the database, this also adds a new
+value to the Git variable ‘remote.<remote>.fetch’, which causes all
+pull-request refs (‘+refs/pull/*/head:refs/pullreqs/*’ for Github) to be
+fetched by Git.
+
+ Note that it is possible to use the same command to add any
+repository from a supported forge to the database, without cloning the
+Git repository first.
+
+ The initial fetch can take a while but most of the work 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: Getting Started, Next: Lists and Menus, Prev: Initial Pull, Up: Top
+
+4 Getting Started
+*****************
+
+Much like Git stores information in a local repository and does not
+require a constant internet connection, Forge retrieves additional
+information using a forge’s API and stores that in a local database.
+
+ Forge’s equivalent of ‘git clone’ is ‘forge-add-repository’, which
+has to be run, before most of Forges features become available in the
+local clone of a Git repository.
+
+‘N / a’ (‘forge-add-repository’)
+ This command guides the user through the process of adding a
+ repository to the local database.
+
+ Note that it is possible to add a repository to the local database,
+ without pulling all the data, which is useful if you just want to
+ create a single issue or pull-request in a repository, but are not
+ interested in existing topics, e.g., because you do not regularly
+ contribute to that repository.
+
+ Also note that you can add a repository to the local database, even
+ if no local Git clone exists.
+
+ Like with Git, you have to explicitly pull remote changes, at your
+leisure, using ‘forge-pull’.
+
+‘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.
+
+ If the current repository isn’t being tracked in the local database
+ yet, then this command pivots to behave like
+ ‘forge-add-repository’.
+
+ Forge adds two additional sections to Magit’s status buffer, which
+list open and/or pending issues and pull-requests. Typing ‘RET’, while
+the cursor is on a topic section, shows more information about that
+topic in a separate buffer. Typing ‘RET’ on a topic list section, shows
+that list in a separate buffer, where you can apply different filters.
+
+ The other main entry point to the functionality provided by Forge is
+the ‘forge-dispatch’ menu.
+
+‘N’ (‘forge-dispatch’)
+ This prefix command is available in all Magit buffers and provides
+ access to most of the available Forge commands. See the following
+ sections for information about the available commands.
+
+\1f
+File: forge.info, Node: Lists and Menus, Next: Visiting Topics, Prev: Getting Started, Up: Top
+
+5 Lists and Menus
+*****************
+
+Topics are listed in two sections in Magit’s status buffer, but can also
+be listed in dedicated buffers. Likewise individual topics can be
+visited in separate buffers. In both cases this can be done by placing
+the cursor on the respective section in the status buffer and typing
+‘RET’, or by invoking the appropriate command from Forge’s main menu, on
+‘N’ (‘forge-dispatch’).
+
+ List commands and corresponding menu commands exist for topics,
+notifications and repositories, but there isn’t always an exclusive
+mapping from menu to buffer. The main menu (‘forge-dispatch’), the
+configuration menu (‘forge-configure’), the menu which controls the
+current topic or the topic at point (‘forge-topic-menu’), and the menu
+which controls the topics listed in the current buffer
+(‘forge-topics-menu’), are useful in more than one major mode.
+
+ All of these menus feature bindings to directly switch to the other
+appropriate menus. So it is enough to remember that ‘N’ always brings
+up the dispatch menu; you can always navigate to another menu from
+there.
+
+ ‘C-c C-c’ brings up the most appropriate menu for the current buffer.
+In Magit’s status buffer the most appropriate menu is Magit’s own
+dispatch menu (‘magit-dispatch’), so here the quickest way to invoke
+Forge’s dispatch menu is ‘N’. Even in Magit’s status buffer, when the
+cursor is an individual topic or on a topic list section, ‘C-c C-c’
+opens the respective menu (‘forge-topics-menu’ or ‘forge-topic-menu’).
+
+ The following sections describe most of the available menu and list
+commands. For ‘forge-topic-menu’, see *note Editing Topics::.
+
+Dispatch and configuration menus
+================================
+
+‘N’ (‘forge-dispatch’)
+ This prefix menu command is available in all Magit buffers and
+ provides access to most of the available Forge commands. See the
+ following sections for information about the available commands.
+
+‘N m c’ (‘forge-configure’)
+ This command displays a menu used to configure the current
+ repository and some global settings as well.
+
+Topic menu and list commands
+============================
+
+‘N m f’ (‘forge-topics-menu’)
+‘C-c C-c [in topics list buffer/section]’
+ This command displays a menu used to control the list of topics
+ displayed in the current buffer.
+
+ Note that this command can not only be used in buffers dedicated to
+ listing topics, but also in Magit’s status buffer.
+
+‘N l t’ (‘forge-list-topics’)
+ This command lists the current repository’s issues in a separate
+ buffer. If the list buffer already exists, this command only
+ ensures that all types of topics are listed. If any other filters
+ are in effect, they are left intact. TODO fix preserving type
+
+‘<RET> [on "Issues" status section]’ (‘forge-list-issues’)
+ This command lists the current repository’s issues in a separate
+ buffer. If the list buffer already exists, this command limits the
+ list to issues. If any other filters are in effect, they are left
+ intact.
+
+‘<RET> [on "Pull requests" status section]’ (‘forge-list-pullreqs’)
+ This command lists the current repository’s pull-requests in a
+ separate buffer. If the list buffer already exists, this command
+ limits the list to pull-requests. If any other filters are in
+ effect, they are left intact.
+
+‘N l g’ (‘forge-list-global-topics’)
+ This command lists topics across all tracked repository. If the
+ list buffer already exists, filters except for the type filter are
+ left in effect.
+
+ -- Command: forge-list-global-issues
+ This command lists issues across all tracked repository. If the
+ list buffer already exists, filters except for the type filter are
+ left in effect.
+
+ -- Command: forge-list-global-pullreqs
+ This command lists pull-requests across all tracked repository. If
+ the list buffer already exists, filters except for the type filter
+ are in effect.
+
+Notification menu and list commands
+===================================
+
+‘N m n’ (‘forge-notifications-menu’)
+‘C-c C-c’
+ This command displays a menu used to control the list of
+ notifications displayed in the current buffer.
+
+‘N l n’ (‘forge-list-notifications’)
+ This command lists all notifications for all forges in a separate
+ buffer.
+
+Repository menu and list commands
+=================================
+
+‘N m r’ (‘forge-repositories-menu’)
+‘C-c C-c’
+ This command displays a menu used to control the list of
+ repositories displayed in the current buffer.
+
+‘N l r’ (‘forge-list-repositories’)
+ This command lists all known repositories in a separate buffer.
+ Here "known" means that an entry exists in the local database.
+
+‘<RET> [on repository]’ (‘forge-visit-this-repository’)
+ This commands visits the repository at point in a separate buffer.
+
+‘o [in forge-repositories-menu]’ (‘forge-list-owned-repositories’)
+ This command lists all known repositories that belong to the user
+ in a separate buffer. Here "known" means that an entry exists in
+ the local database. Only Github is supported for now.
+
+ The below options controls which repositories are considered to be
+owned by the user. They are additionally used by ‘forge-fork’.
+
+ -- 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.
+
+ 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’.
+
+Exiting menus and lists
+=======================
+
+To exit a menu, type ‘C-g’. If the menu was invoked from another menu
+and that menu is useful in the current buffer, then that menu becomes
+active again. If that happens and you actually want to quit all menus,
+then just type ‘C-g’ again. You can also directly exit all menus by
+using ‘C-q’, instead of ‘C-g’.
+
+ Type ‘q’ to quit not only the menu, but also the list or topic detail
+buffer. That binding is also available when no menu is active, in which
+case it will simply quit the buffer. When invoked from a menu, then
+this binding may return to another list buffer, in which case some menu
+may also remain active.
+
+Default topic filters
+=====================
+
+ -- User Option: forge-status-buffer-default-topic-filters
+ This option specifies the filters initially used to limit topics
+ listed in topic list buffers.
+
+ -- User Option: forge-status-buffer-default-topic-filters
+ This option specifies the filters initially used to limit topics
+ listed in Magit status buffers.
+
+ Also see *note Topic sections in Magit status buffers::.
+
+Topic sections in Magit status buffers
+======================================
+
+Forge arranges for certain issues and pull-requests to be list in Magit
+status buffers, by adding the following functions to
+‘magit-status-sections-hook’.
+
+ Which topics are listed initially is customizable using option
+‘forge-status-buffer-default-topic-filters’ and can be changed
+temporarily for the current buffer, using ‘N m f’ (‘forge-topics-menu’).
+
+ -- Function: forge-insert-issues
+ This function inserts a list of issues, by default a list of
+ "active" issues.
+
+ -- Function: forge-insert-pullreqs
+ This function inserts a list of pull-requests, by default a list of
+ "active" pull-requests.
+
+ Forge used to provide additional functions to insert hard-coded topic
+subsets, but they were removed in favor of the more flexible approach
+described above. If you miss the removed sections, you can use the new
+‘forge-insert-topics’ helper function to define your own section
+inserter functions. See its docstring for more information.
+
+ If you don’t want any topic list sections to be displayed in Magit
+status buffers, set ‘forge-add-default-sections’ to ‘nil’ before ‘magit’
+is loaded.
+
+\1f
+File: forge.info, Node: Visiting Topics, Next: Creating Topics and Posts, Prev: Lists and Menus, Up: Top
+
+6 Visiting Topics
+*****************
+
+The commands, accessible from ‘forge-topic-menu’ (on ‘C-return’), act on
+the topic at point; so this menu is useful in buffers dedicated to
+listing topics and notifications (which correspond to topics), but also
+in the status buffer (which also lists topics). In buffers dedicated to
+showing details about a single topic, these commands act on that topic;
+so this menu can be used there too.
+
+ To switch to this menu from another menu use ‘m s’. If the cursor is
+on a topic or the current buffer visits a topic.
+
+ To display details about a topic in a separate buffer and at the same
+time display the topic menu, invoke ‘forge-topic-menu’ with a prefix
+argument, i.e., ‘C-u RET’.
+
+‘<RET> [on topic]’ (‘forge-visit-this-topic’)
+ This commands visits the topic at point in a separate buffer. When
+ invoked with a prefix argument then it not only visits the topic in
+ a separate buffer, it at the same time displays
+
+‘N v t’ (‘forge-visit-topic’)
+‘N v i’ (‘forge-visit-issue’)
+‘N v p’ (‘forge-visit-pullreq’)
+ These commands read a topic, issue or pull-request and visit it in
+ a separate buffer.
+
+‘C-c C-o’ (‘forge-browse’)
+‘o [on topic in topic list]’ (‘forge-browse-this-topic’)
+‘o [on repository in repository list]’ (‘forge-browse-this-repository’)
+ These commands visit the topic, issue(s), pull-request(s), post,
+ branch, commit, remote or repository at point in a browser.
+
+ -- Command: forge-browse-commit
+ -- Command: forge-browse-branch
+ -- Command: forge-browse-repository
+‘N b t’ (‘forge-browse-topic’)
+‘N b i’ (‘forge-browse-issue’)
+‘N b p’ (‘forge-browse-pullreq’)
+‘N b r’ (‘forge-browse-remote’)
+‘N b I’ (‘forge-browse-issues’)
+‘N b P’ (‘forge-browse-pullreqs’)
+ These commands read a topic, issue(s), pull-request(s), branch,
+ commit, remote or repository, and open it in a browser.
+
+\1f
+File: forge.info, Node: Creating Topics and Posts, Next: Editing Topics, Prev: Visiting Topics, Up: Top
+
+7 Creating Topics and Posts
+***************************
+
+We call both issues and pull-requests "topics". The contributions to
+the conversation are called "posts". The initial topic description is
+also called a post.
+
+ Creating a new topic or post and editing an existing post work
+similarly to now creating a new commit or editing the message of an
+existing commit works in Magit. 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 drop you into
+such a buffer.
+
+‘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.
+
+‘C-c C-n’ (‘forge-create-post’)
+‘C-c C-r’
+ This command creates a new post on an existing topic. It is only
+ available in buffers that visit an existing topic.
+
+ If the region is active and marks part of an existing post, then
+ that part of the post is quoted. When a prefix argument is used,
+ then the complete post, which point is currently on, is quoted.
+
+ 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: Editing Topics, Next: Pulling, Prev: Creating Topics and Posts, Up: Top
+
+8 Editing Topics
+****************
+
+Many details about a topic can be changed from the buffer that visits
+that topic, but also from topic lists, if the cursor is placed on the
+topic to be edited. However, to edit the posts on a topic, the topic
+has to be visited in its own buffer.
+
+‘C-c C-e [on a post section]’ (‘forge-edit-post’)
+ This command visits an existing post in a separate buffer, it can
+ only be invoked from a topic buffer, when the cursor is on the post
+ to be edited.
+
+ Editing an existing post is similar to creating a new post, as
+ described in the previous section.
+
+‘C-c C-k [on a post section]’ (‘forge-delete-comment’)
+ This command deletes the post the cursor is on. The initial
+ message that was written when the topic was created, cannot be
+ deleted, only replies to that.
+
+‘N m s’ (‘forge-topic-menu’)
+‘C-<return> [on a topic section]’
+ This command displays a menu used to edit details about the topic
+ the cursor is on or that is being visited in the current buffer.
+ E.g., it can be used to change the status of the topic or to apply
+ labels to it. Additionally it features a few commands that act on
+ that topic.
+
+ Details about a topic, such as its status and labels, can
+alternatively be edited by visiting the topic in its own buffer,
+navigating to the header that displays the detail and then typing ‘C-c
+C-e’. This older approach is still available, but it is usually much
+faster to use the menu.
+
+\1f
+File: forge.info, Node: Pulling, Next: Branching, Prev: Editing Topics, Up: Top
+
+9 Pulling
+*********
+
+The commands that fetch forge data are available the Forge’s main menu
+(‘forge-dispatch’ on ‘N’) and from the same menu (‘magit-fetch’ on ‘f’)
+that is used to fetch Git data. If ‘magit-pull-or-fetch’ is non-nil,
+then they are also available from the ‘magit-pull’ menu (on ‘F’).
+
+ With Git you have to explicitly pull Git data to make it available in
+the local repository. Forge works the same; you have to explicitly pull
+to pull data using the forge’s API and storing in the local database.
+This is less disruptive, more reliable, familiar and easier to
+understand than if Forge pulled 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 and 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.
+
+‘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.
+
+ If the current repository is still untracked locally, or the
+ current repository cannot be determined, this command instead
+ behaves like ‘forge-add-repository’, i.e., it adds the repository
+ to the database and then performs the 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 notifications fetches associated topics even for
+ repositories that you have not yet explicitly added to the local
+ database.
+
+‘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. This is useful if you chose to not
+ fetch all topics when you added the repository using
+ ‘forge-add-repository’.
+
+\1f
+File: forge.info, Node: Branching, Next: Miscellaneous Commands, Prev: Pulling, Up: Top
+
+10 Branching
+************
+
+Forge provides commands for creating and checking out a new branch or
+work tree from a pull-request. These commands are available from the
+same transient prefix commands as the suffix commands, used to create
+and check out branches and work trees in a more generic fashion
+(‘magit-branch’ on ‘b’ and ‘magit-worktree’ on ‘%’).
+
+‘b F’ (‘forge-branch-pullreq’)
+ This command creates and configures a new branch from a
+ pull-request, creating and configuring a new remote if necessary.
+
+ The name of the local branch is the same as the name of the remote
+ branch that you are being asked to merge, unless the contributor
+ could not be bothered to properly name the branch before opening
+ the pull-request. The most likely such case is when you are being
+ asked to merge something like "fork/master" into "origin/master".
+ In such cases the local branch will be named "pr-N", where ‘N’ is
+ the pull-request number.
+
+ These variables are always set by this command:
+
+ • ‘branch.<name>.pullRequest’ is set to the pull-request number.
+ • ‘branch.<name>.pullRequestRemote’ is set to the remote on
+ which the pull-request branch is located.
+ • ‘branch.<name>.pushRemote’ is set to the same remote as
+ ‘branch.<name>.pullRequestRemote’ if that is possible,
+ otherwise it is set to the upstream remote.
+ • ‘branch.<name>.description’ is set to the pull-request title.
+ • ‘branch.<name>.rebase’ is set to ‘true’ because there should
+ be no merge commits among the commits in a pull-request.
+
+ This command also configures the upstream and the push-remote of
+ the local branch that it creates.
+
+ The branch against which the pull-request was opened is always used
+ as the upstream. This makes it easy to see what commits you are
+ being asked to merge in the section titled something like "Unmerged
+ into origin/master".
+
+ Like for other commands that create a branch, it depends on the
+ option ‘magit-branch-prefer-remote-upstream’ whether the remote
+ branch itself or the respective local branch is used as the
+ upstream, so this section may also be titled, e.g., "Unmerged into
+ master".
+
+ When necessary and possible, the remote pull-request branch is
+ configured to be used as the push-target. This makes it easy to
+ see what further changes the contributor has made since you last
+ reviewed their changes in the section titled something like
+ "Unpulled from origin/new-feature" or "Unpulled from
+ fork/new-feature".
+
+ • If the pull-request branch is located in the upstream
+ repository, then you probably have set ‘remote.pushDefault’ to
+ that repository. However some users like to set that variable
+ to their personal fork, even if they have push access to the
+ upstream, so ‘branch.<name>.pushRemote’ is set anyway.
+
+ • If the pull-request branch is located inside a fork, then you
+ are usually able to push to that branch, because Github by
+ default allows the recipient of a pull-request to push to the
+ remote pull-request branch even if it is located in a fork.
+ The contributor has to explicitly disable this.
+
+ • If you are not allowed to push to the pull-request branch
+ on the fork, then a branch by the same name located in
+ the upstream repository is configured as the push-target.
+
+ • A—sadly rather common—special case is when the
+ contributor didn’t bother to use a dedicated branch for
+ the pull-request.
+
+ The most likely such case is when you are being asked to
+ merge something like "fork/master" into "origin/master".
+ The special push permission mentioned above is never
+ granted for the branch that is the repository’s default
+ branch, and that would almost certainly be the case in
+ this scenario.
+
+ To enable you to easily push somewhere anyway, the local
+ branch is named "pr-N" (where ‘N’ is the pull-request
+ number) and the upstream repository is used as the
+ push-remote.
+
+ • Finally, if you are allowed to push to the pull-request
+ branch and the contributor had the foresight to use a
+ dedicated branch, then the fork is configured as the
+ push-remote.
+
+ The push-remote is configured using
+ ‘branch.<name>.pushRemote’, even if the used value is
+ identical to that of ‘remote.pushDefault’, just in case you
+ change the value of the latter later on. Additionally the
+ variable ‘branch.<name>.pullRequestRemote’ is set to the
+ remote on which the pull-request branch is located.
+
+‘b f’ (‘forge-checkout-pullreq’)
+ This command creates and configures a new branch from a
+ pull-request the same way ‘forge-branch-pullreq’ does.
+ Additionally it checks out the new branch.
+
+‘Z n’ (‘forge-checkout-worktree’)
+ This command creates and configures a new branch from a
+ pull-request the same way ‘forge-branch-pullreq’ does.
+ Additionally it checks out the new branch, using a new working
+ tree.
+
+ -- User Option: forge-checkout-worktree-read-directory-function
+ This function is used by ‘forge-checkout-worktree’, to read the new
+ worktree directory where it checks out the 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: Miscellaneous Commands, Next: Miscellaneous Options, Prev: Branching, Up: Top
+
+11 Miscellaneous Commands
+*************************
+
+‘N M’ (‘forge-merge’)
+‘m 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.
+
+‘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 - H’ (‘forge-toggle-topic-legend’)
+ This command toggle whether to show a legend for faces used in
+ topic menus and lists.
+
+‘N - S’ (‘forge-toggle-display-in-status-buffer’)
+ This command toggles whether any topics are displayed in the
+ current Magit status buffer.
+
+‘C-c C-w’ (‘forge-copy-url-at-point-as-kill’)
+ This command copies the url for the topic, issue(s),
+ pull-request(s), post, branch, commit, remote or repository to the
+ kill-ring.
+
+ This determines the url the same way as ‘forge-browse’ does, but
+ then adds it to the kill-ring, instead of visiting it in a browser.
+
+‘M b r’ (‘forge-rename-default-branch’)
+ This command rename the default branch to a new name read from the
+ user.
+
+ This changes the name on the upstream remotely and locally, and
+ update the upstream remotes of local branches accordingly.
+
+ -- Command: forge-add-pullreq-refspec
+ This command configures 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.
+
+ -- 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: Miscellaneous Options, Next: How Forge Detection Works, Prev: Miscellaneous Commands, Up: Top
+
+12 Miscellaneous Options
+************************
+
+ -- User Option: forge-database-file
+ This option specifies the file used to store the forge database.
+
+ -- User Option: forge-topic-repository-slug-width
+ This option specifies the width of repository slugs (i.e.,
+ "OWNER/NAME").
+
+ -- User Option: forge-buffer-draft-p
+ This option controls whether new pull-requests start out as drafts
+ by default.
+
+ The buffer-local value of this variable is used to keep track of
+ the draft status of the current pull-request.
+
+ -- User Option: forge-repository-list-columns
+ This option specifies the list of columns displayed when listing
+ repositories.
+
+ Each element has the form ‘(HEADER SOURCE WIDTH SORT PROPS)’.
+
+ HEADER is the string displayed in the header. WIDTH is the width
+ of the column. SOURCE is used to get the value, it has to be the
+ name of a slot of ‘forge-repository’ or a function that takes such
+ an object as argument. SORT is a boolean or a function used to
+ sort by this column. Supported PROPS include ‘:right-align’ and
+ ‘:pad-right’.
+
+ -- User Option: forge-limit-topic-choices
+ This option controls whether to initially limit completion
+ candidates to active topics.
+
+ -- User Option: forge-post-heading-format
+ This option specifies the 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.
+
+ -- User Option: forge-post-fill-region
+ This option controls whether to call ‘fill-region’ before
+ displaying forge posts.
+
+ -- User Option: forge-bug-reference-hooks
+ This option lists the hooks to which ‘forge-bug-reference-setup’ is
+ added. It has to be customized before ‘forge’ is loaded, or it
+ won’t take effect.
+
+\1f
+File: forge.info, Node: How Forge Detection Works, Next: Supported Forges and Hosts, Prev: Miscellaneous Options, Up: Top
+
+Appendix A How Forge Detection Works
+************************************
+
+Forge uses the Ghub package to communicate with forge APIs. For more
+information about Ghub, see *note (ghub)Top::.
+
+ 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 is 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 variable were
+undefined. I.e., it does not fall through to try ‘origin’ if no remote
+by your chosen name exists.
+
+ Once the upstream remote has been determined, Forge looks it up in
+‘forge-alist’, using the host part of the URL as the key. For example,
+the key for ‘gitNOSPAMgithub.com:magit/forge.git’ is ‘github.com’.
+
+ -- User Option: forge-alist
+ This option defines forge hosts known to Forge.
+
+ Each entry has the form ‘(GITHOST APIHOST WEBHOST CLASS)’.
+
+ • GITHOST is the host used to access repositories on the forge
+ using Git.
+
+ • APIHOST is the host used to access the forge’s API. For some
+ forges the isn’t just a host, but a host followed by the path
+ to the API’s endpoint.
+
+ • WEBHOST is the host used to access repositories on this forge
+ using a browser. The IDs used to identify repositories from
+ the forge in the local database also derives from this value.
+
+ • CLASS is the class to be used for repositories from the forge.
+
+ Complications:
+
+ • When connecting to a Github Enterprise edition whose REST
+ API’s end point is "<host>/v3" and whose GraphQL API’s end
+ point is "<host>/graphql", then use "<host>/v3" as APIHOST.
+ This is a historic accident. See issue #174.
+
+ • WEBHOST and CLASS cannot be changed once you have added one or
+ more repositories from a forge. Changing GITHOST and/or
+ APIHOST may be possible, but should seldom be necessary.
+
+\1f
+File: forge.info, Node: Supported Forges and Hosts, Next: FAQ, Prev: How Forge Detection Works, Up: Top
+
+Appendix B Supported Forges and Hosts
+*************************************
+
+Currently Forge supports two forges and three more forges partially.
+Additionally it supports four semi-forges. Support for more forges and
+semi-forges can and will be added.
+
+ Both forges and semi-forges provide web interfaces for Git
+repositories. Forges additionally support pull-requests and issues and
+make those and other information available using an API.
+
+ When a forge is only partially supported, then that means that only
+the functionality that does not require the API is implemented, or in
+other words, that the forge is only supported as a semi-forge.
+
+ A host is a particular instance of a forge. For example the hosts
+<https://gitlab.com> and <https://salsa.debian.org> are both instances
+of the Gitlab forge. Forge supports some well known hosts out of the
+box and additional hosts can easily be supported by adding entries to
+the option ‘forge-alist’ (see *note How Forge Detection Works::).
+
+ For more details about the caveats mentioned below (and some others)
+see also *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
+
+B.1 Supported Forges
+====================
+
+B.1.1 Github
+------------
+
+Forge’s support for Github can be considered the "reference
+implementation". Support for other forges can lag behind a bit.
+
+B.1.1.1 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.
+
+B.1.1.2 Github Hosts
+....................
+
+ • <https://github.com>
+
+B.1.2 Gitlab
+------------
+
+B.1.2.1 Gitlab Caveats
+......................
+
+ • Forge cannot provide notifications because the Gitlab API does not
+ expose those.
+
+B.1.2.2 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
+
+B.2 Partially Supported Forges
+==============================
+
+B.2.1 Gitea <https://gitea.io>
+------------------------------
+
+This is the next forge whose API will be supported.
+
+B.2.1.1 Gitea Hosts
+...................
+
+ • <https://codeberg.org>
+
+B.2.2 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.
+
+B.2.2.1 Gogs Hosts
+..................
+
+ • <https://code.orgmode.org>
+
+B.2.3 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.
+
+B.2.3.1 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>.
+
+B.2.3.2 Bitbucket Hosts
+.......................
+
+ • <https://bitbucket.org>
+
+\1f
+File: forge.info, Node: Supported Semi-Forges, Prev: Partially Supported Forges, Up: Supported Forges and Hosts
+
+B.3 Supported Semi-Forges
+=========================
+
+B.3.1 Gitweb <https://git-scm.com/docs/gitweb>
+----------------------------------------------
+
+B.3.1.1 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).
+
+B.3.2 Cgit <https://git.zx2c4.com/cgit/about>
+---------------------------------------------
+
+B.3.2.1 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.
+
+B.3.2.2 Cgit Hosts
+..................
+
+ • <https://git.savannah.gnu.org/cgit>
+ • <https://git.kernel.org>
+ • <https://repo.or.cz>
+
+B.3.3 Stgit <https://codemadness.org/git/stagit/file/README.html>
+-----------------------------------------------------------------
+
+B.3.3.1 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).
+
+B.3.3.2 Stgit Hosts
+...................
+
+ • <https://git.suckless.org>
+
+B.3.4 Srht <https://meta.sr.ht>
+-------------------------------
+
+B.3.4.1 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).
+
+B.3.4.2 Srht Hosts
+..................
+
+ • <https://git.sr.ht>
+
+\1f
+File: forge.info, Node: FAQ, Next: Keystroke Index, Prev: Supported Forges and Hosts, Up: Top
+
+Appendix C FAQ
+**************
+
+This section lists some frequently asked questions. Please see also
+<https://github.com/magit/forge/wiki/FAQ> for an extended list of common
+issues.
+
+* Menu:
+
+* ‘error in process filter HTTP Error 502, "Bad gateway"’: error in process filter HTTP Error 502 "Bad gateway".
+
+\1f
+File: forge.info, Node: error in process filter HTTP Error 502 "Bad gateway", Up: FAQ
+
+C.1 ‘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.
+Unfortunately the reason given is rather vague, but I believe this
+usually happens when there are topics with one or two magnitudes more
+posts than usual, which can cause GraphQL responses to become huge.
+
+ This can be countered in the affected repository by setting the Git
+variable ‘forge.graphqlItemLimit’:
+
+ git config --local forge.graphqlItemLimit 20
+
+ The default is specified using the ‘ghub-graphql-items-per-request’,
+which defaults to 50 (down from Github’s default and maximum of 100).
+
+ Fetching less items per request results in more requests, which slows
+down the process, which is why the default should not be too small, but
+for some repositories a more aggressive limit is needed.
+
+\1f
+File: forge.info, Node: Keystroke Index, Next: Function and Command Index, Prev: FAQ, Up: Top
+
+Appendix D Keystroke Index
+**************************
+
+\0\b[index\0\b]
+* Menu:
+
+* b F: Branching. (line 13)
+* b f: Branching. (line 102)
+* C-<return> [on a topic section]: Editing Topics. (line 26)
+* C-c C-c: Lists and Menus. (line 97)
+* C-c C-c <1>: Lists and Menus. (line 109)
+* C-c C-c <2>: Creating Topics and Posts.
+ (line 37)
+* C-c C-c [in topics list buffer/section]: Lists and Menus. (line 53)
+* C-c C-e: Creating Topics and Posts.
+ (line 45)
+* C-c C-e d: Creating Topics and Posts.
+ (line 50)
+* C-c C-e [on a post section]: Editing Topics. (line 12)
+* C-c C-k: Creating Topics and Posts.
+ (line 41)
+* C-c C-k [on a post section]: Editing Topics. (line 20)
+* C-c C-n: Creating Topics and Posts.
+ (line 27)
+* C-c C-n [on "Issues" section]: Creating Topics and Posts.
+ (line 23)
+* C-c C-n [on "Pull requests" section]: Creating Topics and Posts.
+ (line 19)
+* C-c C-o: Visiting Topics. (line 34)
+* C-c C-r: Creating Topics and Posts.
+ (line 27)
+* C-c C-w: Miscellaneous Commands.
+ (line 37)
+* f n: Getting Started. (line 32)
+* f n <1>: Pulling. (line 23)
+* f N: Pulling. (line 34)
+* M b r: Miscellaneous Commands.
+ (line 45)
+* m M [if enabled]: Miscellaneous Commands.
+ (line 8)
+* N: Getting Started. (line 50)
+* N <1>: Lists and Menus. (line 40)
+* N - H: Miscellaneous Commands.
+ (line 29)
+* N - S: Miscellaneous Commands.
+ (line 33)
+* N / a: Getting Started. (line 15)
+* N b i: Visiting Topics. (line 46)
+* N b I: Visiting Topics. (line 46)
+* N b p: Visiting Topics. (line 46)
+* N b P: Visiting Topics. (line 46)
+* N b r: Visiting Topics. (line 46)
+* N b t: Visiting Topics. (line 46)
+* N c f: Miscellaneous Commands.
+ (line 21)
+* N c i: Creating Topics and Posts.
+ (line 23)
+* N c p: Creating Topics and Posts.
+ (line 19)
+* N f f: Getting Started. (line 32)
+* N f f <1>: Pulling. (line 23)
+* N f n: Pulling. (line 34)
+* N f t: Pulling. (line 43)
+* N l g: Lists and Menus. (line 78)
+* N l n: Lists and Menus. (line 101)
+* N l r: Lists and Menus. (line 113)
+* N l t: Lists and Menus. (line 60)
+* N M: Miscellaneous Commands.
+ (line 8)
+* N m c: Lists and Menus. (line 45)
+* N m f: Lists and Menus. (line 53)
+* N m n: Lists and Menus. (line 97)
+* N m r: Lists and Menus. (line 109)
+* N m s: Editing Topics. (line 26)
+* N r: How Forge Detection Works.
+ (line 83)
+* N v i: Visiting Topics. (line 28)
+* N v p: Visiting Topics. (line 28)
+* N v t: Visiting Topics. (line 28)
+* o [in forge-repositories-menu]: Lists and Menus. (line 120)
+* o [on repository in repository list]: Visiting Topics. (line 34)
+* o [on topic in topic list]: Visiting Topics. (line 34)
+* RET [on "Issues" status section]: Lists and Menus. (line 66)
+* RET [on "Pull requests" status section]: Lists and Menus. (line 72)
+* RET [on repository]: Lists and Menus. (line 117)
+* RET [on topic]: Visiting Topics. (line 21)
+* Z n: Branching. (line 107)
+
+\1f
+File: forge.info, Node: Function and Command Index, Next: Variable Index, Prev: Keystroke Index, Up: Top
+
+Appendix E Function and Command Index
+*************************************
+
+\0\b[index\0\b]
+* Menu:
+
+* forge-add-organization-repositories: Miscellaneous Commands.
+ (line 64)
+* forge-add-pullreq-refspec: Miscellaneous Commands.
+ (line 51)
+* forge-add-repository: Getting Started. (line 15)
+* forge-add-user-repositories: Miscellaneous Commands.
+ (line 58)
+* forge-branch-pullreq: Branching. (line 13)
+* forge-browse: Visiting Topics. (line 34)
+* forge-browse-branch: Visiting Topics. (line 38)
+* forge-browse-commit: Visiting Topics. (line 37)
+* forge-browse-issue: Visiting Topics. (line 46)
+* forge-browse-issues: Visiting Topics. (line 46)
+* forge-browse-pullreq: Visiting Topics. (line 46)
+* forge-browse-pullreqs: Visiting Topics. (line 46)
+* forge-browse-remote: Visiting Topics. (line 46)
+* forge-browse-repository: Visiting Topics. (line 39)
+* forge-browse-this-repository: Visiting Topics. (line 34)
+* forge-browse-this-topic: Visiting Topics. (line 34)
+* forge-browse-topic: Visiting Topics. (line 46)
+* forge-checkout-pullreq: Branching. (line 102)
+* forge-checkout-worktree: Branching. (line 107)
+* forge-configure: Lists and Menus. (line 45)
+* forge-copy-url-at-point-as-kill: Miscellaneous Commands.
+ (line 37)
+* forge-create-issue: Creating Topics and Posts.
+ (line 23)
+* forge-create-post: Creating Topics and Posts.
+ (line 27)
+* forge-create-pullreq: Creating Topics and Posts.
+ (line 19)
+* forge-delete-comment: Editing Topics. (line 20)
+* forge-dispatch: Getting Started. (line 50)
+* forge-dispatch <1>: Lists and Menus. (line 40)
+* forge-edit-post: Editing Topics. (line 12)
+* forge-forge.remote: How Forge Detection Works.
+ (line 83)
+* forge-fork: Miscellaneous Commands.
+ (line 21)
+* forge-insert-issues: Lists and Menus. (line 184)
+* forge-insert-pullreqs: Lists and Menus. (line 188)
+* forge-list-global-issues: Lists and Menus. (line 82)
+* forge-list-global-pullreqs: Lists and Menus. (line 87)
+* forge-list-global-topics: Lists and Menus. (line 78)
+* forge-list-issues: Lists and Menus. (line 66)
+* forge-list-notifications: Lists and Menus. (line 101)
+* forge-list-owned-repositories: Lists and Menus. (line 120)
+* forge-list-pullreqs: Lists and Menus. (line 72)
+* forge-list-repositories: Lists and Menus. (line 113)
+* forge-list-topics: Lists and Menus. (line 60)
+* forge-merge: Miscellaneous Commands.
+ (line 8)
+* forge-notifications-menu: Lists and Menus. (line 97)
+* forge-post-cancel: Creating Topics and Posts.
+ (line 41)
+* forge-post-dispatch: Creating Topics and Posts.
+ (line 45)
+* forge-post-submit: Creating Topics and Posts.
+ (line 37)
+* forge-post-toggle-draft: Creating Topics and Posts.
+ (line 50)
+* forge-pull: Getting Started. (line 32)
+* forge-pull <1>: Pulling. (line 23)
+* forge-pull-notifications: Pulling. (line 34)
+* forge-pull-topic: Pulling. (line 43)
+* forge-remove-repository: Miscellaneous Commands.
+ (line 71)
+* forge-remove-topic-locally: Miscellaneous Commands.
+ (line 75)
+* forge-rename-default-branch: Miscellaneous Commands.
+ (line 45)
+* forge-repositories-menu: Lists and Menus. (line 109)
+* forge-reset-database: Miscellaneous Commands.
+ (line 85)
+* forge-toggle-display-in-status-buffer: Miscellaneous Commands.
+ (line 33)
+* forge-toggle-topic-legend: Miscellaneous Commands.
+ (line 29)
+* forge-topic-menu: Editing Topics. (line 26)
+* forge-topics-menu: Lists and Menus. (line 53)
+* forge-visit-issue: Visiting Topics. (line 28)
+* forge-visit-pullreq: Visiting Topics. (line 28)
+* forge-visit-this-repository: Lists and Menus. (line 117)
+* forge-visit-this-topic: Visiting Topics. (line 21)
+* forge-visit-topic: Visiting Topics. (line 28)
+
+\1f
+File: forge.info, Node: Variable Index, Prev: Function and Command Index, Up: Top
+
+Appendix F Variable Index
+*************************
+
+\0\b[index\0\b]
+* Menu:
+
+* forge-alist: How Forge Detection Works.
+ (line 95)
+* forge-buffer-draft-p: Miscellaneous Options.
+ (line 13)
+* forge-bug-reference-hooks: Miscellaneous Options.
+ (line 50)
+* forge-checkout-worktree-read-directory-function: Branching. (line 112)
+* forge-database-file: Miscellaneous Options.
+ (line 6)
+* forge-limit-topic-choices: Miscellaneous Options.
+ (line 33)
+* forge-owned-accounts: Lists and Menus. (line 127)
+* forge-owned-ignored: Lists and Menus. (line 140)
+* forge-post-fill-region: Miscellaneous Options.
+ (line 46)
+* forge-post-heading-format: Miscellaneous Options.
+ (line 37)
+* forge-repository-list-columns: Miscellaneous Options.
+ (line 20)
+* forge-status-buffer-default-topic-filters: Lists and Menus. (line 163)
+* forge-status-buffer-default-topic-filters <1>: Lists and Menus.
+ (line 167)
+* forge-topic-repository-slug-width: Miscellaneous Options.
+ (line 9)
+* forge.remote: How Forge Detection Works.
+ (line 69)
+
+
+\1f
+Tag Table:
+Node: Top\7f771
+Node: Introduction\7f2507
+Node: Initial Setup\7f2928
+Ref: Common Setup\7f3633
+Node: Setup for Githubcom\7f4227
+Ref: Set your Username\7f4388
+Ref: Create and Store an Access Token\7f4718
+Node: Setup for Another Github Instance\7f6586
+Ref: Tell Forge about the Instance\7f7134
+Ref: Set your Username (1)\7f8680
+Ref: Create and Store an Access Token (1)\7f8988
+Node: Setup for Gitlabcom\7f11089
+Ref: Set your Username (2)\7f11292
+Ref: Create and Store an Access Token (2)\7f11622
+Node: Setup for Another Gitlab Instance\7f13513
+Ref: Tell Forge about the Instance (1)\7f14074
+Ref: Set your Username (3)\7f15415
+Ref: Create and Store an Access Token (3)\7f15723
+Node: Setup a Partially Supported Host\7f17775
+Ref: Tell Forge about the Instance (2)\7f18460
+Ref: Add Support for Additional Forge Types\7f19956
+Node: Initial Pull\7f21127
+Node: Getting Started\7f22334
+Node: Lists and Menus\7f24620
+Ref: Dispatch and configuration menus\7f26444
+Ref: Topic menu and list commands\7f26903
+Ref: Notification menu and list commands\7f28840
+Ref: Repository menu and list commands\7f29217
+Ref: Exiting menus and lists\7f30984
+Ref: Default topic filters\7f31679
+Ref: Topic sections in Magit status buffers\7f32119
+Node: Visiting Topics\7f33350
+Node: Creating Topics and Posts\7f35464
+Node: Editing Topics\7f37546
+Node: Pulling\7f39171
+Node: Branching\7f41333
+Node: Miscellaneous Commands\7f47726
+Node: Miscellaneous Options\7f51450
+Node: How Forge Detection Works\7f53535
+Node: Supported Forges and Hosts\7f59072
+Node: Supported Forges\7f60381
+Ref: Github\7f60537
+Ref: Github Caveats\7f60692
+Ref: Github Hosts\7f61354
+Ref: Gitlab\7f61426
+Ref: Gitlab Caveats\7f61453
+Ref: Gitlab Hosts\7f61594
+Node: Partially Supported Forges\7f61730
+Ref: Gitea https//giteaio\7f61936
+Ref: Gitea Hosts\7f62052
+Ref: Gogs https//gogsio\7f62124
+Ref: Gogs Hosts\7f62343
+Ref: Bitbucket https//bitbucketorg\7f62417
+Ref: Bitbucket Caveats\7f62631
+Ref: Bitbucket Hosts\7f63544
+Node: Supported Semi-Forges\7f63625
+Ref: Gitweb https//git-scmcom/docs/gitweb\7f63796
+Ref: Gitweb Caveats\7f63891
+Ref: Cgit https//gitzx2c4com/cgit/about\7f64147
+Ref: Cgit Caveats\7f64240
+Ref: Cgit Hosts\7f64605
+Ref: Stgit https//codemadnessorg/git/stagit/file/READMEhtml\7f64748
+Ref: Stgit Caveats\7f64881
+Ref: Stgit Hosts\7f65183
+Ref: Srht https//metasrht\7f65259
+Ref: Srht Caveats\7f65324
+Ref: Srht Hosts\7f65623
+Node: FAQ\7f65690
+Node: error in process filter HTTP Error 502 "Bad gateway"\7f66100
+Node: Keystroke Index\7f67581
+Node: Function and Command Index\7f73561
+Node: Variable Index\7f79841
+\1f
+End Tag Table
+
+\1f
+Local Variables:
+coding: utf-8
+End:
projects / emacsconfig.git / commitdiff