From 3b1da581ac7661fc215b5db7d5d535cf249b4083 Mon Sep 17 00:00:00 2001 From: Andreas Gerler Date: Thu, 30 May 2024 18:29:55 +0200 Subject: [PATCH] add forge --- elpa/forge-20240523.1103/dir | 18 + elpa/forge-20240523.1103/forge-autoloads.el | 302 ++++ elpa/forge-20240523.1103/forge-bitbucket.el | 46 + elpa/forge-20240523.1103/forge-commands.el | 1133 ++++++++++++++ elpa/forge-20240523.1103/forge-core.el | 395 +++++ elpa/forge-20240523.1103/forge-db.el | 549 +++++++ elpa/forge-20240523.1103/forge-gitea.el | 47 + elpa/forge-20240523.1103/forge-github.el | 858 ++++++++++ elpa/forge-20240523.1103/forge-gitlab.el | 684 ++++++++ elpa/forge-20240523.1103/forge-gogs.el | 46 + elpa/forge-20240523.1103/forge-issue.el | 278 ++++ elpa/forge-20240523.1103/forge-notify.el | 327 ++++ elpa/forge-20240523.1103/forge-pkg.el | 23 + elpa/forge-20240523.1103/forge-post.el | 255 +++ elpa/forge-20240523.1103/forge-pullreq.el | 358 +++++ elpa/forge-20240523.1103/forge-repo.el | 531 +++++++ elpa/forge-20240523.1103/forge-repos.el | 193 +++ elpa/forge-20240523.1103/forge-revnote.el | 47 + elpa/forge-20240523.1103/forge-semi.el | 83 + elpa/forge-20240523.1103/forge-tablist.el | 85 + elpa/forge-20240523.1103/forge-topic.el | 1566 +++++++++++++++++++ elpa/forge-20240523.1103/forge-topics.el | 488 ++++++ elpa/forge-20240523.1103/forge.el | 169 ++ elpa/forge-20240523.1103/forge.info | 1537 ++++++++++++++++++ 24 files changed, 10018 insertions(+) create mode 100644 elpa/forge-20240523.1103/dir create mode 100644 elpa/forge-20240523.1103/forge-autoloads.el create mode 100644 elpa/forge-20240523.1103/forge-bitbucket.el create mode 100644 elpa/forge-20240523.1103/forge-commands.el create mode 100644 elpa/forge-20240523.1103/forge-core.el create mode 100644 elpa/forge-20240523.1103/forge-db.el create mode 100644 elpa/forge-20240523.1103/forge-gitea.el create mode 100644 elpa/forge-20240523.1103/forge-github.el create mode 100644 elpa/forge-20240523.1103/forge-gitlab.el create mode 100644 elpa/forge-20240523.1103/forge-gogs.el create mode 100644 elpa/forge-20240523.1103/forge-issue.el create mode 100644 elpa/forge-20240523.1103/forge-notify.el create mode 100644 elpa/forge-20240523.1103/forge-pkg.el create mode 100644 elpa/forge-20240523.1103/forge-post.el create mode 100644 elpa/forge-20240523.1103/forge-pullreq.el create mode 100644 elpa/forge-20240523.1103/forge-repo.el create mode 100644 elpa/forge-20240523.1103/forge-repos.el create mode 100644 elpa/forge-20240523.1103/forge-revnote.el create mode 100644 elpa/forge-20240523.1103/forge-semi.el create mode 100644 elpa/forge-20240523.1103/forge-tablist.el create mode 100644 elpa/forge-20240523.1103/forge-topic.el create mode 100644 elpa/forge-20240523.1103/forge-topics.el create mode 100644 elpa/forge-20240523.1103/forge.el create mode 100644 elpa/forge-20240523.1103/forge.info diff --git a/elpa/forge-20240523.1103/dir b/elpa/forge-20240523.1103/dir new file mode 100644 index 00000000..e9289b26 --- /dev/null +++ b/elpa/forge-20240523.1103/dir @@ -0,0 +1,18 @@ +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. + +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" 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. diff --git a/elpa/forge-20240523.1103/forge-autoloads.el b/elpa/forge-20240523.1103/forge-autoloads.el new file mode 100644 index 00000000..cce3a830 --- /dev/null +++ b/elpa/forge-20240523.1103/forge-autoloads.el @@ -0,0 +1,302 @@ +;;; 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))) + + + +;;; 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 " " #'forge-browse) (keymap-set magit-mode-map " " #'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-")) + + +;;; Generated autoloads from forge-bitbucket.el + +(register-definition-prefixes "forge-bitbucket" '("forge-bitbucket-repository")) + + +;;; Generated autoloads from forge-commands.el + + (autoload 'forge-dispatch "forge-commands" nil t) + (autoload 'forge-configure "forge-commands" nil t) +(autoload 'forge-pull "forge-commands" "\ +Pull forge topics for the current repository if it is already tracked. +If the current repository is still untracked locally, or the current +repository cannot be determined, instead invoke `forge-add-repository'." t) +(autoload 'forge-pull-notifications "forge-commands" "\ +Fetch notifications for all repositories from the current forge." t) + (autoload 'forge-pull-topic "forge-commands" nil t) + (autoload 'forge-pull-this-topic "forge-commands" nil t) +(autoload 'forge-browse-issues "forge-commands" "\ +Visit the current repository's issues using a browser." t) +(autoload 'forge-browse-pullreqs "forge-commands" "\ +Visit the current repository's pull-requests using a browser." t) +(autoload 'forge-browse-topic "forge-commands" "\ +Read a TOPIC and visit it using a browser. +By default only offer open topics but with a prefix argument +also offer closed topics. + +(fn TOPIC)" t) +(autoload 'forge-browse-issue "forge-commands" "\ +Read an ISSUE and visit it using a browser. +By default only offer open issues but with a prefix argument +also offer closed issues. + +(fn ISSUE)" t) +(autoload 'forge-browse-pullreq "forge-commands" "\ +Read a PULL-REQUEST and visit it using a browser. +By default only offer open pull-requests but with a prefix +argument also offer closed pull-requests. + +(fn PULL-REQUEST)" t) +(autoload 'forge-browse-commit "forge-commands" "\ +Read a COMMIT and visit it using a browser. + +(fn COMMIT)" t) +(autoload 'forge-browse-branch "forge-commands" "\ +Read a BRANCH and visit it using a browser. + +(fn BRANCH)" t) +(autoload 'forge-browse-remote "forge-commands" "\ +Read a REMOTE and visit it using a browser. + +(fn REMOTE)" t) +(autoload 'forge-browse-repository "forge-commands" "\ +Read a REPOSITORY and visit it using a browser. + +(fn REPOSITORY)" t) + (autoload 'forge-browse-this-topic "forge-commands" nil t) +(autoload 'forge-browse-this-repository "forge-commands" "\ +Visit the repository at point using a browser." t) +(autoload 'forge-copy-url-at-point-as-kill "forge-commands" "\ +Copy the url of the thing at point." t) +(autoload 'forge-browse "forge-commands" "\ +Visit the thing at point using a browser." t) +(autoload 'forge-visit-topic "forge-commands" "\ +Read a TOPIC and visit it. +By default only offer open topics for completion; +with a prefix argument also closed topics. + +(fn TOPIC)" t) +(autoload 'forge-visit-issue "forge-commands" "\ +Read an ISSUE and visit it. +By default only offer open topics for completion; +with a prefix argument also closed topics. + +(fn ISSUE)" t) +(autoload 'forge-visit-pullreq "forge-commands" "\ +Read a PULL-REQUEST and visit it. +By default only offer open topics for completion; +with a prefix argument also closed topics. + +(fn PULL-REQUEST)" t) +(autoload 'forge-visit-this-topic "forge-commands" "\ +Visit the topic at point." t) +(autoload 'forge-visit-this-repository "forge-commands" "\ +Visit the repository at point." t) +(autoload 'forge-branch-pullreq "forge-commands" "\ +Create and configure a new branch from a pull-request. +Please see the manual for more information. + +(fn PULLREQ)" t) +(autoload 'forge-checkout-pullreq "forge-commands" "\ +Create, configure and checkout a new branch from a pull-request. +Please see the manual for more information. + +(fn PULLREQ)" t) +(autoload 'forge-checkout-worktree "forge-commands" "\ +Create, configure and checkout a new worktree from a pull-request. +This is like `forge-checkout-pullreq', except that it also +creates a new worktree. Please see the manual for more +information. + +(fn PATH PULLREQ)" t) +(autoload 'forge-fork "forge-commands" "\ +Fork the current repository to FORK and add it as a REMOTE. +If the fork already exists, then that isn't an error; the remote +is added anyway. Currently this only supports Github and Gitlab. + +(fn FORK REMOTE)" t) +(autoload 'forge-merge "forge-commands" "\ +Merge the current pull-request using METHOD using the forge's API. + +If there is no current pull-request or with a prefix argument, +then read pull-request PULLREQ to visit instead. + +Use of this command is discouraged. Unless the remote repository +is configured to disallow that, you should instead merge locally +and then push the target branch. Forges detect that you have +done that and respond by automatically marking the pull-request +as merged. + +(fn PULLREQ METHOD)" t) +(autoload 'forge-rename-default-branch "forge-commands" "\ +Rename the default branch to NEWNAME. +Change the name on the upstream remote and locally, and update +the upstream remotes of local branches accordingly." t) + (autoload 'forge-add-pullreq-refspec "forge-commands" nil t) + (autoload 'forge-add-repository "forge-commands" nil t) +(autoload 'forge-add-user-repositories "forge-commands" "\ +Add all of USER's repositories from HOST to the database. +This may take a while. Only Github is supported at the moment. + +(fn HOST USER)" t) +(autoload 'forge-add-organization-repositories "forge-commands" "\ +Add all of ORGANIZATION's repositories from HOST to the database. +This may take a while. Only Github is supported at the moment. + +(fn HOST ORGANIZATION)" t) +(autoload 'forge-remove-repository "forge-commands" "\ +Remove a repository from the database. + +(fn REPOSITORY)" t) +(autoload 'forge-remove-topic-locally "forge-commands" "\ +Remove a topic from the local database only. +Due to how the supported APIs work, it would be too expensive to +automatically remove topics from the local database that were +removed from the forge. The purpose of this command is to allow +you to manually clean up the local database. + +(fn TOPIC)" t) +(autoload 'forge-reset-database "forge-commands" "\ +Move the current database file to the trash. +This is useful after the database scheme has changed, which will +happen a few times while the forge functionality is still under +heavy development." t) +(register-definition-prefixes "forge-commands" '("forge-")) + + +;;; Generated autoloads from forge-core.el + +(register-definition-prefixes "forge-core" '("forge-")) + + +;;; Generated autoloads from forge-db.el + +(register-definition-prefixes "forge-db" '("forge-")) + + +;;; Generated autoloads from forge-gitea.el + +(register-definition-prefixes "forge-gitea" '("forge-gitea-repository")) + + +;;; Generated autoloads from forge-github.el + +(register-definition-prefixes "forge-github" '("forge-")) + + +;;; Generated autoloads from forge-gitlab.el + +(register-definition-prefixes "forge-gitlab" '("forge-gitlab-repository")) + + +;;; Generated autoloads from forge-gogs.el + +(register-definition-prefixes "forge-gogs" '("forge-gogs-repository")) + + +;;; Generated autoloads from forge-issue.el + +(register-definition-prefixes "forge-issue" '("forge-")) + + +;;; Generated autoloads from forge-notify.el + +(autoload 'forge-list-notifications "forge-notify" "\ +List notifications." t) +(register-definition-prefixes "forge-notify" '("forge-")) + + +;;; Generated autoloads from forge-post.el + +(register-definition-prefixes "forge-post" '("forge-")) + + +;;; Generated autoloads from forge-pullreq.el + +(register-definition-prefixes "forge-pullreq" '("forge-")) + + +;;; Generated autoloads from forge-repo.el + +(register-definition-prefixes "forge-repo" '("forge-")) + + +;;; 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-")) + + +;;; Generated autoloads from forge-revnote.el + +(register-definition-prefixes "forge-revnote" '("forge-revnote")) + + +;;; Generated autoloads from forge-semi.el + +(register-definition-prefixes "forge-semi" '("forge-")) + + +;;; Generated autoloads from forge-tablist.el + +(register-definition-prefixes "forge-tablist" '("forge--")) + + +;;; 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-")) + + +;;; Generated autoloads from forge-topics.el + + (autoload 'forge-topics-menu "forge-topics" nil t) + (autoload 'forge-list-topics "forge-topics" nil t) + (autoload 'forge-list-labeled-topics "forge-topics" nil t) + (autoload 'forge-list-assigned-topics "forge-topics" nil t) + (autoload 'forge-list-authored-topics "forge-topics" nil t) + (autoload 'forge-list-owned-topics "forge-topics" nil t) + (autoload 'forge-list-issues "forge-topics" nil t) + (autoload 'forge-list-labeled-issues "forge-topics" nil t) + (autoload 'forge-list-assigned-issues "forge-topics" nil t) + (autoload 'forge-list-authored-issues "forge-topics" nil t) + (autoload 'forge-list-owned-issues "forge-topics" nil t) + (autoload 'forge-list-pullreqs "forge-topics" nil t) + (autoload 'forge-list-labeled-pullreqs "forge-topics" nil t) + (autoload 'forge-list-assigned-pullreqs "forge-topics" nil t) + (autoload 'forge-list-requested-reviews "forge-topics" nil t) + (autoload 'forge-list-authored-pullreqs "forge-topics" nil t) + (autoload 'forge-list-owned-pullreqs "forge-topics" nil t) +(register-definition-prefixes "forge-topics" '("forge-")) + +;;; 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 diff --git a/elpa/forge-20240523.1103/forge-bitbucket.el b/elpa/forge-20240523.1103/forge-bitbucket.el new file mode 100644 index 00000000..e4cf219a --- /dev/null +++ b/elpa/forge-20240523.1103/forge-bitbucket.el @@ -0,0 +1,46 @@ +;;; forge-bitbucket.el --- Bitbucket support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2024 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . + +;;; Code: + +(require '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 diff --git a/elpa/forge-20240523.1103/forge-commands.el b/elpa/forge-20240523.1103/forge-commands.el new file mode 100644 index 00000000..1abd89bd --- /dev/null +++ b/elpa/forge-20240523.1103/forge-commands.el @@ -0,0 +1,1133 @@ +;;; forge-commands.el --- Commands -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2024 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . + +;;; Code: + +(require 'forge) + +;;; Options + +(defcustom forge-add-pullreq-refspec t + "Whether the pull-request refspec is added when setting up a repository. + +This controls whether running `forge-pull' for the first time in +a repository also adds a refspec that fetches all pull-requests. +In repositories with huge numbers of pull-requests you might want +to not do so, in which case you should set this option to `ask'. + +You can also set this to nil and later add the refspec explicitly +for a repository using the command `forge-add-pullreq-refspec'." + :package-version '(forge . "0.2.0") + :group 'forge + :type '(choice (const :tag "Always add refspec" t) + (const :tag "Ask every time" ask) + (const :tag "Never add refspec" nil))) + +(defcustom forge-checkout-worktree-read-directory-function + 'forge-checkout-worktree-default-read-directory-function + "Function used by `forge-checkout-worktree' to read worktree directory. +Takes the pull-request as only argument and must return a directory." + :package-version '(forge . "0.4.0") + :group 'forge + :type 'function) + +;;; Dispatch + +;;;###autoload (autoload 'forge-dispatch "forge-commands" nil t) +(transient-define-prefix forge-dispatch () + "Dispatch a forge command." + [:if forge--get-repository:tracked? + ["Create" + ("c i" "issue" forge-create-issue) + ("c p" "pull-request" forge-create-pullreq) + ("c u" "pull-request from issue" + forge-create-pullreq-from-issue + :if forge--get-github-repository) + ("c f" "fork or remote" forge-fork)]] + [:if forge--get-repository:tracked? + ["List" + ("t" "topics... " forge-topics-menu :transient replace) + ("n" "notifications... " forge-notifications-menu :transient replace) + ("r" "repositories... " forge-repositories-menu :transient replace)] + ["Fetch" + ("f f" "all topics " forge-pull) + ("f t" "one topic " forge-pull-topic) + ("f n" "notifications " forge-pull-notifications)] + ["Do" + :if forge--get-repository:tracked? + ("C" "configure" forge-configure) + ("M" "merge w/api" forge-merge :level 7)]] + [:if forge--get-repository:tracked? + ["Visit" + ("v t" "topic" forge-visit-topic) + ("v i" "issue" forge-visit-issue) + ("v p" "pull-request" forge-visit-pullreq)] + ["Browse" + ("b t" "topic" forge-browse-topic) + ("b i" "issue" forge-browse-issue) + ("b p" "pull-request" forge-browse-pullreq)] + ["Browse" + ("b r" "remote" forge-browse-remote) + ("b I" "issues" forge-browse-issues) + ("b P" "pull-requests" forge-browse-pullreqs)]] + [[:description (lambda () + (if (magit-gitdir) + "Forge doesn't know about this Git repository yet" + "Not inside a Git repository")) + :if-not forge--get-repository:tracked? + ("a" "add repository to database" forge-add-repository) + ("f" "fetch notifications" forge-pull-notifications) + ("l" "list notifications" forge-list-notifications)]]) + +;;;###autoload (autoload 'forge-configure "forge-commands" nil t) +(transient-define-prefix forge-configure () + "Configure current repository and global settings." + [["Configure" + :if forge--get-repository:tracked? + ("a " "add another repository to database" forge-add-some-repository) + ("R " forge-add-pullreq-refspec) + ("s r" forge-forge.remote) + ("s l" forge-forge.graphqlItemLimit) + ("s s" forge-toggle-display-in-status-buffer) + ("s c" forge-toggle-closed-visibility)]]) + +;;; Pull + +;;;###autoload +(defun forge-pull () + "Pull forge topics for the current repository if it is already tracked. +If the current repository is still untracked locally, or the current +repository cannot be determined, instead invoke `forge-add-repository'." + (interactive) + (if-let ((repo (forge-get-repository :tracked?))) + (forge--pull repo) + (transient-setup 'forge-add-repository nil nil + :scope (forge-get-repository :stub)))) + +(defun forge-read-date (prompt) + (require (quote org) nil) + (if (fboundp 'org-read-date) + (org-read-date nil nil nil prompt) + (cl-block nil + (while t + (let ((str (read-from-minibuffer prompt))) + (cond ((string-equal str "") + (cl-return nil)) + ((string-match-p + "\\`[0-9]\\{4\\}[-/][0-9]\\{2\\}[-/][0-9]\\{2\\}\\'" str) + (cl-return str)))) + (message "Please enter a date in the format YYYY-MM-DD.") + (sit-for 1))))) + +(cl-defmethod forge--pull ((repo forge-noapi-repository) &rest _) + (forge--msg repo t t "Pulling from REPO is not supported")) + +(cl-defmethod forge--pull ((repo forge-unusedapi-repository) &rest _) + (magit-git-fetch (oref repo remote) (magit-fetch-arguments))) + +(defun forge--maybe-git-fetch (repo &optional buffer) + (if (and (buffer-live-p buffer) + (with-current-buffer buffer + (and (derived-mode-p 'magit-mode) + (forge-repository-equal (forge-get-repository :stub?) repo)))) + (with-current-buffer buffer + (magit-git-fetch (oref repo remote) (magit-fetch-arguments))) + (when-let ((worktree (forge-get-worktree repo))) + (let ((default-directory worktree) + (magit-inhibit-refresh t)) + (magit-git-fetch (oref repo remote) (magit-fetch-arguments)))))) + +;;;###autoload +(defun forge-pull-notifications () + "Fetch notifications for all repositories from the current forge." + (interactive) + (if-let ((repo (forge-get-repository :stub?))) + (let ((class (eieio-object-class repo))) + (if (eq class 'forge-github-repository) + (forge--pull-notifications class (oref repo githost)) + (user-error "Fetching notifications not supported for forge %S" + (oref repo forge)))) + (forge--pull-notifications 'forge-github-repository "github.com"))) + +;;;###autoload (autoload 'forge-pull-topic "forge-commands" nil t) +(transient-define-suffix forge-pull-topic (number) + "Read a topic TYPE and NUMBER pull data about it from its forge." + :inapt-if-not #'forge--get-github-repository + (interactive + (list (read-number "Pull topic: " + (and-let* ((topic (forge-current-topic))) + (oref topic number))))) + (forge--pull-topic (forge-get-repository :tracked) number)) + +;;;###autoload (autoload 'forge-pull-this-topic "forge-commands" nil t) +(transient-define-suffix forge-pull-this-topic () + "Pull data about the topic at point from its forge." + :inapt-if-not #'forge--get-github-repository + :description "fetch" + (interactive) + (let ((topic (forge-current-topic t))) + (forge--pull-topic (forge-get-repository topic) topic))) + +(cl-defmethod forge--pull-topic ((repo forge-repository) _topic) + (error "Fetching an individual topic not implemented for %s" + (eieio-object-class repo))) + +;;; Browse + +;;;###autoload +(defun forge-browse-issues () + "Visit the current repository's issues using a browser." + (interactive) + (browse-url (forge--format (forge-get-repository :stub) + 'issues-url-format))) + +;;;###autoload +(defun forge-browse-pullreqs () + "Visit the current repository's pull-requests using a browser." + (interactive) + (browse-url (forge--format (forge-get-repository :stub) + 'pullreqs-url-format))) + +;;;###autoload +(defun forge-browse-topic (topic) + "Read a TOPIC and visit it using a browser. +By default only offer open topics but with a prefix argument +also offer closed topics." + (interactive (list (forge-read-topic "Browse topic"))) + (forge--browse-topic topic)) + +;;;###autoload +(defun forge-browse-issue (issue) + "Read an ISSUE and visit it using a browser. +By default only offer open issues but with a prefix argument +also offer closed issues." + (interactive (list (forge-read-issue "Browse issue"))) + (forge--browse-topic issue)) + +;;;###autoload +(defun forge-browse-pullreq (pull-request) + "Read a PULL-REQUEST and visit it using a browser. +By default only offer open pull-requests but with a prefix +argument also offer closed pull-requests." + (interactive (list (forge-read-pullreq "Browse pull-request"))) + (forge--browse-topic pull-request)) + +(defun forge--browse-topic (topic) + (let ((obj (forge-get-topic topic))) + (browse-url (forge-get-url obj)) + (forge-topic-mark-read obj))) + +;;;###autoload +(defun forge-browse-commit (commit) + "Read a COMMIT and visit it using a browser." + (interactive + (list (or (magit-completing-read "Browse commit" + (magit-list-branch-names) + nil nil nil 'magit-revision-history + (magit-branch-or-commit-at-point)) + (user-error "Nothing selected")))) + (browse-url (forge-get-url :commit commit))) + +;;;###autoload +(defun forge-browse-branch (branch) + "Read a BRANCH and visit it using a browser." + (interactive (list (magit-read-branch "Browse branch"))) + (browse-url (forge-get-url :branch branch))) + +;;;###autoload +(defun forge-browse-remote (remote) + "Read a REMOTE and visit it using a browser." + (interactive (list (magit-read-remote "Browse remote" nil t))) + (browse-url (forge-get-url :remote remote))) + +;;;###autoload +(defun forge-browse-repository (repository) + "Read a REPOSITORY and visit it using a browser." + (interactive (list (forge-read-repository "Browse repository"))) + (browse-url (forge-get-url repository))) + +;;;###autoload (autoload 'forge-browse-this-topic "forge-commands" nil t) +(transient-define-suffix forge-browse-this-topic () + "Visit the topic at point using a browser." + :description "browse" + (interactive) + (forge-browse-topic (forge-current-topic t))) + +;;;###autoload +(defun forge-browse-this-repository () + "Visit the repository at point using a browser." + (interactive) + (forge-browse-repository (forge-repository-at-point t))) + +;;;###autoload +(defun forge-copy-url-at-point-as-kill () + "Copy the url of the thing at point." + (interactive) + (if-let ((target (forge--browse-target))) + (let ((url (if (stringp target) target (forge-get-url target)))) + (kill-new url) + (message "Copied \"%s\"" url)) + (user-error "Nothing at point with a URL"))) + +;;;###autoload +(defun forge-browse () + "Visit the thing at point using a browser." + (interactive) + (if-let ((target (forge--browse-target))) + (if (stringp target) + (browse-url target) + (browse-url (forge-get-url target)) + (when (cl-typep target 'forge-topic) + (forge-topic-mark-read target))) + (user-error "Nothing to browse here"))) + +(defun forge--browse-target () + (or (and-let* ((branch (magit--painted-branch-at-point))) + (forge-get-url :branch branch)) + (and-let* ((commit (magit-commit-at-point))) + (forge-get-url :commit commit)) + (and-let* ((branch (magit-branch-at-point))) + (forge-get-url :branch branch)) + (and-let* ((remote (magit-remote-at-point))) + (forge-get-url :remote remote)) + (forge-post-at-point) + (forge-current-topic) + (and magit-buffer-revision + (forge-get-url :commit magit-buffer-revision)) + (forge-current-repository))) + +;;;; Urls + +(cl-defgeneric forge-get-url (obj) + "Return the URL for a forge object.") + +(cl-defmethod forge-get-url ((issue forge-issue)) + (forge--format issue 'issue-url-format)) + +(cl-defmethod forge-get-url ((pullreq forge-pullreq)) + (forge--format pullreq 'pullreq-url-format)) + +(cl-defmethod forge-get-url ((repo forge-repository)) + (forge--format repo 'remote-url-format)) + +(cl-defmethod forge-get-url ((_(eql :commit)) commit) + (let ((repo (forge-get-repository :stub))) + (unless (magit-list-containing-branches + commit "-r" (concat (oref repo remote) "/*")) + (if-let* ((branch (car (magit-list-containing-branches commit "-r"))) + (remote (cdr (magit-split-branch-name branch)))) + (setq repo (forge-get-repository :stub remote)) + (message "%s does not appear to be available on any remote. %s" + commit "You might have to push it first."))) + (forge--format repo 'commit-url-format + `((?r . ,(magit-commit-p commit)))))) + +(cl-defmethod forge-get-url ((_(eql :branch)) branch) + (let (remote) + (if (magit-remote-branch-p branch) + (let ((cons (magit-split-branch-name branch))) + (setq remote (car cons)) + (setq branch (cdr cons))) + (unless (setq remote (or (magit-get-push-remote branch) + (magit-get-upstream-remote branch))) + (user-error "Cannot determine remote for %s" branch))) + (forge--format (forge-get-repository :stub remote) + 'branch-url-format + `((?r . ,branch))))) + +(cl-defmethod forge-get-url ((_(eql :remote)) remote) + (forge--format (forge-get-repository :stub remote) 'remote-url-format)) + +(cl-defmethod forge-get-url ((post forge-post)) + (forge--format post (let ((topic (forge-get-parent post))) + (cond ((forge--childp topic 'forge-issue) + 'issue-post-url-format) + ((forge--childp topic 'forge-pullreq) + 'pullreq-post-url-format))))) + +(cl-defmethod forge-get-url ((notify forge-notification)) + (oref notify url)) + +;;; Visit + +;;;###autoload +(defun forge-visit-topic (topic) + "Read a TOPIC and visit it. +By default only offer open topics for completion; +with a prefix argument also closed topics." + (interactive (list (forge-read-topic "View topic"))) + (forge-topic-setup-buffer (forge-get-topic topic))) + +;;;###autoload +(defun forge-visit-issue (issue) + "Read an ISSUE and visit it. +By default only offer open topics for completion; +with a prefix argument also closed topics." + (interactive (list (forge-read-issue "View issue"))) + (forge-topic-setup-buffer (forge-get-issue issue))) + +;;;###autoload +(defun forge-visit-pullreq (pull-request) + "Read a PULL-REQUEST and visit it. +By default only offer open topics for completion; +with a prefix argument also closed topics." + (interactive (list (forge-read-pullreq "View pull-request"))) + (forge-topic-setup-buffer (forge-get-pullreq pull-request))) + +;;;###autoload +(defun forge-visit-this-topic () + "Visit the topic at point." + (interactive) + (forge-topic-setup-buffer (forge-topic-at-point))) + +;;;###autoload +(defun forge-visit-this-repository () + "Visit the repository at point." + (interactive) + (let* ((repo (forge-repository-at-point)) + (worktree (forge-get-worktree repo))) + (cond + ((eq transient-current-command 'forge-repositories-menu) + (if-let ((buffer (forge-topic-get-buffer repo))) + (switch-to-buffer buffer) + (forge-list-topics repo)) + (transient-setup 'forge-topics-menu)) + (worktree + (magit-status-setup-buffer worktree)) + ((forge-list-topics repo))))) + +;;; Create + +(defun forge-create-issue () + "Create a new issue for the current repository." + (interactive) + (let* ((repo (forge-get-repository :tracked)) + (buf (forge--prepare-post-buffer + "new-issue" + (forge--format repo "Create new issue on %p")))) + (when buf + (with-current-buffer buf + (setq forge--buffer-post-object repo) + (setq forge--submit-post-function #'forge--submit-create-issue)) + (forge--display-post-buffer buf)))) + +(defun forge-create-pullreq (source target) + "Create a new pull-request for the current repository." + (interactive (forge-create-pullreq--read-args)) + (let* ((repo (forge-get-repository :tracked)) + (buf (forge--prepare-post-buffer + "new-pullreq" + (forge--format repo "Create new pull-request on %p") + source target))) + (with-current-buffer buf + (setq forge--buffer-base-branch target) + (setq forge--buffer-head-branch source) + (setq forge--buffer-post-object repo) + (setq forge--submit-post-function #'forge--submit-create-pullreq) + (run-hooks 'forge-create-pullreq-hook)) + (forge--display-post-buffer buf))) + +(transient-define-suffix forge-create-pullreq-from-issue (issue source target) + "Convert an existing ISSUE into a pull-request." + :description "convert to pull-request" + :if (lambda () + (let ((issue (forge-current-issue))) + (and issue (eq (oref issue state) 'open) + issue))) + (interactive (cons (forge-read-open-issue "Convert issue") + (forge-create-pullreq--read-args))) + (setq issue (forge-get-issue issue)) + (forge--create-pullreq-from-issue (forge-get-repository issue) + issue source target)) + +(defun forge-create-pullreq--read-args () + (let* ((source (magit-completing-read + "Source branch" + (magit-list-remote-branch-names) + nil t nil 'magit-revision-history + (or (and-let* ((d (magit-branch-at-point))) + (if (magit-remote-branch-p d) + d + (magit-get-push-branch d t))) + (and-let* ((d (magit-get-current-branch))) + (if (magit-remote-branch-p d) + d + (magit-get-push-branch d t)))))) + (repo (forge-get-repository :tracked)) + (remote (oref repo remote)) + (targets (delete source (magit-list-remote-branch-names remote))) + (target (magit-completing-read + "Target branch" targets nil t nil 'magit-revision-history + (let* ((d (cdr (magit-split-branch-name source))) + (d (and (magit-branch-p d) d)) + (d (and d (magit-get-upstream-branch d))) + (d (and d (if (magit-remote-branch-p d) + d + (magit-get-upstream-branch d)))) + (d (or d (concat remote "/" + (or (oref repo default-branch) + "master"))))) + (car (member d targets)))))) + (list source target))) + +(defun forge-create-post (&optional quote) + "Create a new post on an existing topic. +If the region is active, then quote that part of the post. +Otherwise and with a prefix argument quote the post that +point is currently on." + (interactive (list current-prefix-arg)) + (unless (derived-mode-p 'forge-topic-mode) + (user-error "This command is only available from topic buffers")) + (let* ((topic forge-buffer-topic) + (buf (forge--prepare-post-buffer + (forge--format topic "%i;new-comment") + (forge--format topic "New comment on #%i of %p"))) + (quote (cond + ((not (magit-section-match 'post)) nil) + ((use-region-p) + (buffer-substring-no-properties (region-beginning) + (region-end))) + (quote + (let ((section (magit-current-section))) + (string-trim-right + (buffer-substring-no-properties (oref section content) + (oref section end)))))))) + (with-current-buffer buf + (setq forge--buffer-post-object topic) + (setq forge--submit-post-function #'forge--submit-create-post) + (when quote + (goto-char (point-max)) + (unless (bobp) + (insert "\n")) + (insert (replace-regexp-in-string "^" "> " quote) "\n\n"))) + (forge--display-post-buffer buf))) + +;;; Edit + +(defun forge-edit-post () + "Edit the current post." + (interactive) + (let* ((post (forge-post-at-point t)) + (buf (cl-typecase post + (forge-topic + (forge--prepare-post-buffer + (forge--format post "%i") + (forge--format post "Edit #%i of %p"))) + (forge-post + (forge--prepare-post-buffer + (forge--format post "%i;%I") + (forge--format post "Edit comment on #%i of %p")))))) + (with-current-buffer buf + (setq forge--buffer-post-object post) + (setq forge--submit-post-function #'forge--submit-edit-post) + (erase-buffer) + (when (cl-typep post 'forge-topic) + (insert "# " (oref post title) "\n\n")) + (insert (oref post body))) + (forge--display-post-buffer buf))) + +(transient-define-suffix forge-edit-topic-note () + "Edit your private note about the current topic." + :transient #'transient--do-quit-all + :description + (lambda () + (if-let ((topic (forge-current-topic))) + (concat "note " + (if-let ((note (oref topic note))) + (propertize (substring note 0 (string-match-p "$" note)) + 'face 'font-lock-string-face) + (propertize "none" 'face 'magit-dimmed))) + "note")) + (interactive) + (let* ((topic (forge-current-topic t)) + (buf (forge--prepare-post-buffer + (forge--format topic "%i;note") + (forge--format topic "New note on #%i of %p")))) + (with-current-buffer buf + (setq forge--buffer-post-object topic) + (setq forge--submit-post-function #'forge--save-note) + (erase-buffer) + (when-let ((note (oref topic note))) + (save-excursion (insert note ?\n)))) + (forge--display-post-buffer buf))) + +;;; Delete + +(transient-define-suffix forge-delete-comment () + "Delete the comment at point." + :description "delete comment" + :inapt-if-not #'forge-comment-at-point + (interactive) + (let ((comment (forge-comment-at-point t))) + (when (yes-or-no-p "Really delete the current comment? ") + (forge--delete-comment (forge-get-repository :tracked) comment)))) + +;;; Branch + +;;;###autoload +(defun forge-branch-pullreq (pullreq) + "Create and configure a new branch from a pull-request. +Please see the manual for more information." + (interactive (list (forge-read-pullreq "Branch pull request"))) + (let ((pullreq (forge-get-pullreq pullreq))) + (if-let ((branch (forge--pullreq-branch-active pullreq))) + (progn (message "Branch %S already exists and is configured" branch) + branch) + (forge--branch-pullreq (forge-get-repository pullreq) pullreq) + (forge-refresh-buffer)))) + +(cl-defmethod forge--branch-pullreq ((pullreq forge-pullreq)) + (forge--branch-pullreq (forge-get-repository pullreq) pullreq)) + +(cl-defmethod forge--branch-pullreq ((_repo forge-unusedapi-repository) pullreq) + ;; We don't know enough to do a good job. + (let* ((number (oref pullreq number)) + (branch (format "pr-%s" number))) + (when (magit-branch-p branch) + (user-error "Branch `%s' already exists" branch)) + (magit-git "branch" branch (forge--pullreq-ref pullreq)) + ;; More often than not this is the correct target branch. + (magit-call-git "branch" branch "--set-upstream-to=master") + (magit-set (number-to-string number) "branch" branch "pullRequest") + branch)) + +(cl-defmethod forge--branch-pullreq ((repo forge-repository) pullreq) + (let* ((number (oref pullreq number)) + (branch-n (format "pr-%s" number)) + (branch (or (forge--pullreq-branch-internal pullreq) branch-n)) + (pullreq-ref (format "refs/pullreqs/%s" number))) + (cond ((and-let* ((pr-branch (oref pullreq head-ref))) + (string-search ":" pr-branch)) + ;; Such a branch name would be invalid. If we encounter + ;; it anyway, then that means that the source branch and + ;; the merge-request ref are missing. Luckily Gitlab no + ;; longer does this, but we nevertheless have to deal + ;; with merge-requests that have been lost in time. + (error "Cannot check out this merge-request because %s" + "on old Gitlab version discarded the source branch")) + ((not (eq (oref pullreq state) 'open)) + (magit-git "branch" "--force" branch pullreq-ref)) + (t + (let ((upstream (oref repo remote)) + (pr-remote (oref pullreq head-user)) + (pr-branch (oref pullreq head-ref))) + (cond ((not (oref pullreq cross-repo-p)) + (let ((tracking (concat upstream "/" pr-branch))) + (unless (magit-branch-p tracking) + (magit-call-git "fetch" upstream)) + (forge--setup-pullreq-branch branch tracking) + (magit-branch-maybe-adjust-upstream branch tracking) + (magit-set upstream "branch" branch "pushRemote") + (magit-set upstream "branch" branch "pullRequestRemote"))) + ((not pr-branch) + ;; The pullreq branch (on Github) has been deleted. + (setq pr-remote nil) + (setq branch branch-n) + (forge--setup-pullreq-branch branch pullreq-ref) + (magit-set upstream "branch" branch "pushRemote")) + (t + ;; For prs within the upstream we are more permissive, + ;; but any request to merge a branch with a well known + ;; name from fork, is highly suspicious and likely the + ;; result of a contributor not bothering to name their + ;; feature branch. + (when (and (member branch magit-main-branch-names) + (magit-branch-p branch)) + (setq branch branch-n)) + (forge--setup-pullreq-remote pullreq) + (forge--setup-pullreq-branch + branch (concat pr-remote "/" pr-branch)) + (if (and (oref pullreq editable-p) + (equal branch pr-branch)) + (magit-set pr-remote "branch" branch "pushRemote") + (magit-set upstream "branch" branch "pushRemote")))) + (when pr-remote + (magit-set pr-remote "branch" branch "pullRequestRemote")) + (magit-set "true" "branch" branch "rebase") + (magit-git "branch" branch + (let ((base-ref (oref pullreq base-ref))) + (concat "--set-upstream-to=" + (if (or magit-branch-prefer-remote-upstream + (not (magit-branch-p base-ref))) + (concat upstream "/" base-ref) + base-ref))))))) + (magit-set (number-to-string number) "branch" branch "pullRequest") + (magit-set (oref pullreq title) "branch" branch "description") + branch)) + +(defun forge--setup-pullreq-branch (branch tracking) + (if (magit-branch-p branch) + (unless (magit-rev-equal branch tracking) + (message "Existing branch %s diverged from %s" branch tracking)) + (magit-git "branch" branch tracking))) + +(defun forge--setup-pullreq-remote (pullreq) + (let* ((pr-remote (oref pullreq head-user)) + (pr-branch (oref pullreq head-ref)) + (repo (forge-get-repository pullreq)) + (host (oref repo githost)) + (user (oref pullreq head-user)) + (fork (oref pullreq head-repo))) + (if (magit-remote-p pr-remote) + (let ((url (magit-git-string "remote" "get-url" pr-remote)) + (fetch (magit-get-all "remote" pr-remote "fetch"))) + (unless (equal (forge--split-forge-url url) + (list host user (substring fork (1+ (length user))))) + (user-error "Remote `%s' already exists but does not point to %s" + pr-remote url)) + (unless (or (member (format "+refs/heads/*:refs/remotes/%s/*" + pr-remote) + fetch) + (member (format "+refs/heads/%s:refs/remotes/%s/%s" + pr-branch pr-remote pr-branch) + fetch)) + (magit-git "remote" "set-branches" "--add" pr-remote pr-branch) + (magit-git "fetch" pr-remote))) + (let ((url (magit-git-string "remote" "get-url" (oref repo remote)))) + (magit-git + "remote" "add" "-f" "--no-tags" + "-t" pr-branch pr-remote + (cond ((or (string-prefix-p "git@" url) + (string-prefix-p "ssh://git@" url)) + (format "git@%s:%s.git" host fork)) + ((string-prefix-p "https://" url) + (format "https://%s/%s.git" host fork)) + ((string-prefix-p "git://" url) + (format "git://%s/%s.git" host fork)) + ((string-prefix-p "http://" url) + (format "http://%s/%s.git" host fork)) + ((error "%s has an unexpected format" url)))))))) + +;;;###autoload +(defun forge-checkout-pullreq (pullreq) + "Create, configure and checkout a new branch from a pull-request. +Please see the manual for more information." + (interactive (list (forge-read-pullreq "Checkout pull request"))) + (magit--checkout (forge--branch-pullreq (forge-get-pullreq pullreq))) + (forge-refresh-buffer)) + +;;;###autoload +(defun forge-checkout-worktree (path pullreq) + "Create, configure and checkout a new worktree from a pull-request. +This is like `forge-checkout-pullreq', except that it also +creates a new worktree. Please see the manual for more +information." + (interactive + (let ((id (forge-read-pullreq "Checkout pull request"))) + (list (funcall forge-checkout-worktree-read-directory-function + (forge-get-pullreq id)) + id))) + (when (and (file-exists-p path) + (not (and (file-directory-p path) + (length= (directory-files path) 2)))) + (user-error "%s already exists and isn't empty" path)) + (magit-worktree-checkout path + (forge--branch-pullreq (forge-get-pullreq pullreq)))) + +(defun forge-checkout-worktree-default-read-directory-function (pullreq) + (pcase-let* (((eieio number head-ref) pullreq) + (path (read-directory-name + (format "Checkout #%s in new worktree: " number) + (file-name-directory + (directory-file-name default-directory)) + nil nil + (let ((branch (forge--pullreq-branch-internal pullreq))) + (if (string-match-p "\\`pr-[0-9]+\\'" branch) + (number-to-string number) + (format "%s-%s" number + (string-replace "/" "-" head-ref))))))) + (when (equal path "") + (user-error "The empty string isn't a valid path")) + path)) + +;;; Marks + +(defun forge-create-mark (name face description) + "Define a new mark that topics can be marked with." + (interactive + (list (read-string "Name: ") + (magit-read-char-case "Set appearance using " nil + (?n "a face [n]ame" + (read-face-name "Face name: ")) + (?s "face [s]exp" + (read-from-minibuffer + "Face sexp: " + "(:background \"\" :foreground \"\" :box t)" + read-expression-map t))) + (let ((str (read-string "Description: "))) + (and (not (equal str "")) str)))) + (forge-sql [:insert-into mark :values $v1] + (vector nil (forge--uuid) name face description))) + +(defun forge-edit-mark (id name face description) + "Define a new mark that topics can be marked with." + (interactive + (pcase-let* + ((marks (forge-sql [:select [name id face description] :from mark])) + (`(,name ,id ,face ,description) + (assoc (completing-read "Edit mark" (mapcar #'car marks) nil t) + marks))) + (list id + (read-string "Name: " name) + (magit-read-char-case "Set appearance using " nil + (?n "a face [n]ame" + (read-face-name "Face name: " (and (symbolp face) face))) + (?s "face [s]exp" + (read-from-minibuffer + "Face sexp: " + (if (listp face) + (format "%S" face) + "(:background \"\" :foreground \"\" :box t)") + read-expression-map t))) + (let ((str (read-string "Description: " nil nil description))) + (and (not (equal str "")) str))))) + (forge-sql [:update mark + :set (= [name face description] $v1) + :where (= id $s2)] + (vector name face description) id)) + +;;; Remotely + +;;;###autoload +(defun forge-fork (fork remote) + "Fork the current repository to FORK and add it as a REMOTE. +If the fork already exists, then that isn't an error; the remote +is added anyway. Currently this only supports Github and Gitlab." + (interactive + (let ((fork (magit-completing-read "Fork to" + (mapcar #'car forge-owned-accounts)))) + (list fork + (read-string "Remote name: " + (or (plist-get (cdr (assoc fork forge-owned-accounts)) + 'remote-name) + fork))))) + (let ((repo (forge-get-repository :stub))) + (forge--fork-repository repo fork) + (magit-remote-add remote + (magit-clone--format-url (oref repo githost) fork + (oref repo name)) + (list "--fetch")))) + +;;;###autoload +(defun forge-merge (pullreq method) + "Merge the current pull-request using METHOD using the forge's API. + +If there is no current pull-request or with a prefix argument, +then read pull-request PULLREQ to visit instead. + +Use of this command is discouraged. Unless the remote repository +is configured to disallow that, you should instead merge locally +and then push the target branch. Forges detect that you have +done that and respond by automatically marking the pull-request +as merged." + (interactive + (list (forge-read-pullreq "Merge pull-request") + (if (forge--childp (forge-get-repository :tracked) + 'forge-gitlab-repository) + (magit-read-char-case "Merge method " t + (?m "[m]erge" 'merge) + (?s "[s]quash" 'squash)) + (magit-read-char-case "Merge method " t + (?m "[m]erge" 'merge) + (?s "[s]quash" 'squash) + (?r "[r]ebase" 'rebase))))) + (let ((pullreq (forge-get-pullreq pullreq))) + (forge--merge-pullreq (forge-get-repository pullreq) + pullreq + (magit-rev-hash + (forge--pullreq-branch-internal pullreq)) + method)) + (forge-pull)) + +;;;###autoload +(defun forge-rename-default-branch () + "Rename the default branch to NEWNAME. +Change the name on the upstream remote and locally, and update +the upstream remotes of local branches accordingly." + (interactive) + (let* ((repo (forge-get-repository :tracked?)) + (_ (unless (forge-github-repository-p repo) + (user-error "Updating default branch not supported for forge `%s'" + (oref repo forge)))) + (remote (or (and (fboundp 'forge--get-remote) + (forge--get-remote)) + (magit-get-some-remote) + (user-error "No remote configured"))) + (symref (format "refs/remotes/%s/HEAD" remote)) + (oldhead (progn + (message "Determining old default branch...") + (magit-git "fetch" "--prune") + (magit-git "remote" "set-head" "--auto" remote) + (message "Determining old default branch...done") + (magit-git-string "symbolic-ref" "--short" symref))) + (oldname (if oldhead + (cdr (magit-split-branch-name oldhead)) + (error "Cannot determine old default branch"))) + (default (and (not (equal oldname "main")) "main")) + (newname (read-string + (format "Rename default branch `%s' to%s: " + oldname + (if default (format " (default: %s)" default) "")) + nil nil default))) + (message "Renaming default branch...") + (forge--set-default-branch repo newname oldname) + (forge-refresh-buffer) + (message "Renaming default branch...done"))) + +;;; Configuration + +(transient-define-infix forge-forge.remote () + "Change the local value of the `forge.remote' Git variable." + :class 'magit--git-variable:choices + :variable "forge.remote" + :choices #'magit-list-remotes + :default (lambda (_) (forge--get-remote t))) + +(transient-define-infix forge-forge.graphqlItemLimit () + "Change the maximum number of GraphQL entities to pull at once." + :if #'forge--get-github-repository + :class 'magit--git-variable + :variable "forge.graphqlItemLimit" + :reader #'read-string + :default (lambda () (number-to-string ghub-graphql-items-per-request))) + +(transient-define-suffix forge-toggle-display-in-status-buffer () + "Toggle whether to display topics in the current status buffer." + :inapt-if-not (lambda () + (and (eq major-mode 'magit-status-mode) + (forge-get-repository :known?))) + :description (lambda () + (if forge-display-in-status-buffer + "hide all topics" + "display topics")) + :transient t + (interactive) + (setq forge-display-in-status-buffer (not forge-display-in-status-buffer)) + (forge-refresh-buffer)) + +(transient-define-suffix forge-toggle-closed-visibility () + "Toggle whether to display recently closed topics. +This only affect the current status buffer." + :inapt-if-not (lambda () + (and forge-display-in-status-buffer + (eq major-mode 'magit-status-mode) + (forge-get-repository :known?))) + :description (lambda () + (if (or (atom forge-topic-list-limit) + (> (cdr forge-topic-list-limit) 0)) + "hide closed topics" + "display recently closed topics")) + :transient t + (interactive) + (make-local-variable 'forge-topic-list-limit) + (if (atom forge-topic-list-limit) + (setq forge-topic-list-limit (cons forge-topic-list-limit 5)) + (setcdr forge-topic-list-limit (* -1 (cdr forge-topic-list-limit)))) + (forge-refresh-buffer)) + +;;;###autoload (autoload 'forge-add-pullreq-refspec "forge-commands" nil t) +(transient-define-suffix forge-add-pullreq-refspec () + "Configure Git to fetch all pull-requests. +This is done by adding \"+refs/pull/*/head:refs/pullreqs/*\" +to the value of `remote.REMOTE.fetch', where REMOTE is the +upstream remote. Also fetch from REMOTE." + :if-not 'forge--pullreq-refspec + :description "add pull-request refspec" + (interactive) + (let* ((repo (forge-get-repository :stub)) + (remote (oref repo remote)) + (fetch (magit-get-all "remote" remote "fetch")) + (refspec (oref repo pullreq-refspec))) + (if (member refspec fetch) + (message "Pull-request refspec is already active") + (magit-call-git "config" "--add" + (format "remote.%s.fetch" remote) + refspec) + (magit-git-fetch remote (magit-fetch-arguments))))) + +(defun forge--pullreq-refspec () + (let* ((repo (forge-get-repository :stub)) + (remote (oref repo remote)) + (fetch (magit-get-all "remote" remote "fetch")) + (refspec (oref repo pullreq-refspec))) + (car (member refspec fetch)))) + +;;; Add repositories + +;;;###autoload (autoload 'forge-add-repository "forge-commands" nil t) +(transient-define-prefix forge-add-repository (&optional repo limit) + "Add a repository to the database." + [:class transient-subgroups + [:if (lambda () (forge-get-repository (transient-scope) nil :tracked?)) + (:info + (lambda () + (format + (propertize "%s is already being tracked" 'face 'transient-heading) + (propertize (forge-get-url (transient-scope)) 'face 'bold))) + :format "%d")] + [:if-not (lambda () (forge-get-repository (transient-scope) nil :tracked?)) + :description + (lambda () + (format + (propertize "Adding %s to database," 'face 'transient-heading) + (propertize (forge-get-url (transient-scope)) 'face 'bold))) + ("a" "pulling all topics" + (lambda (repo) + (interactive (list (transient-scope))) + (forge-add-repository repo))) + ("s" "pulling only topics since " + (lambda (repo date) + (interactive + (list (transient-scope) + (forge-read-date "Limit pulling to topics updated since: "))) + (forge-add-repository repo date))) + ("i" "to allow pulling of individual topics" + (lambda (repo) + (interactive (list (transient-scope))) + (forge-add-repository repo :selective)))] + [("o" "Add another repository" forge-add-some-repository) + (7 "U" "Add all source repositories belonging to a user" + forge-add-user-repositories) + (7 "O" "Add all source repositories belonging to an organization" + forge-add-organization-repositories)]] + (declare (interactive-only nil)) + (interactive) + (cond + ((not repo) + (transient-setup 'forge-add-repository nil nil + :scope (forge-get-repository :stub?))) + ((stringp repo) + (transient-setup 'forge-add-repository nil nil + :scope (forge-get-repository repo nil :stub?))) + (t + (when-let* + (((not (eq limit :selective))) + ((magit-git-config-p "forge.autoPull" t)) + (remote (oref repo remote)) + (refspec (oref repo pullreq-refspec)) + ((and (not (member refspec (magit-get-all "remote" remote "fetch"))) + (or (eq forge-add-pullreq-refspec t) + (and (eq forge-add-pullreq-refspec 'ask) + (y-or-n-p (format "Also add %S refspec? " refspec))))))) + (magit-call-git "config" "--add" + (format "remote.%s.fetch" remote) + refspec)) + (setq repo (forge-get-repository repo nil :insert!)) + (when (eq limit :selective) + (oset repo selective-p t) + (setq limit nil)) + (forge--pull repo nil limit)))) + +(defun forge-add-some-repository (url) + "Read a repository and add it to the database." + (interactive + (let (ret url) + (while (not ret) + (setq url (magit-read-string-ns + "Add repository to database (url, owner/name, or name)" url)) + (unless (string-match-p "\\(://\\|@\\)" url) + (setq url (magit-clone--name-to-url url))) + (cond ((forge-get-repository url nil :tracked?) + (message "%s is already being tracked locally" + (propertize url 'face 'bold)) + (sit-for 3)) + ((not (forge-get-repository url nil :valid?)) + (message "%s does not exist or is inaccessible" + (propertize url 'face 'bold)) + (sit-for 3)) + ((setq ret url)))) + (list ret))) + (forge-add-repository url)) + +;;;###autoload +(defun forge-add-user-repositories (host user) + "Add all of USER's repositories from HOST to the database. +This may take a while. Only Github is supported at the moment." + (interactive + (list (forge-read-host "Add repositories from Github host" + 'forge-github-repository) + (read-string "User: "))) + (forge--add-user-repos 'forge-github-repository host user)) + +;;;###autoload +(defun forge-add-organization-repositories (host organization) + "Add all of ORGANIZATION's repositories from HOST to the database. +This may take a while. Only Github is supported at the moment." + (interactive + (list (forge-read-host "Add repositories from Github host" + 'forge-github-repository) + (read-string "Organization: "))) + (forge--add-organization-repos 'forge-github-repository host organization)) + +;;; Cleanup + +;;;###autoload +(defun forge-remove-repository (repository) + "Remove a repository from the database." + (interactive + (pcase-let* ((repo (forge-read-repository "Remove repository from db")) + ((eieio githost owner name) repo)) + (if (yes-or-no-p (format "Do you really want to remove \"%s/%s @%s\" %s? " + owner name githost "from the database")) + (list repo) + (user-error "Abort")))) + (closql-delete repository) + (forge-refresh-buffer)) + +;;;###autoload +(defun forge-remove-topic-locally (topic) + "Remove a topic from the local database only. +Due to how the supported APIs work, it would be too expensive to +automatically remove topics from the local database that were +removed from the forge. The purpose of this command is to allow +you to manually clean up the local database." + (interactive (list (forge-read-topic "Delete topic LOCALLY only"))) + (setq topic (forge-get-topic topic)) + (closql-delete topic) + (if (and (derived-mode-p 'forge-topic-mode) + (eq (oref topic id) + (oref forge-buffer-topic id))) + (kill-buffer (current-buffer)) + (forge-refresh-buffer))) + +;;;###autoload +(defun forge-reset-database () + "Move the current database file to the trash. +This is useful after the database scheme has changed, which will +happen a few times while the forge functionality is still under +heavy development." + (interactive) + (when (and (file-exists-p forge-database-file) + (yes-or-no-p "Really trash Forge's database file? ")) + (when-let ((db (forge-db t))) + (emacsql-close db)) + (delete-file forge-database-file t) + (forge-refresh-buffer))) + +;;; Miscellaneous + +(magit-define-section-jumper forge-jump-to-pullreqs "Pull requests" pullreqs) +(magit-define-section-jumper forge-jump-to-issues "Issues" issues) + +;;; _ +(provide 'forge-commands) +;;; forge-commands.el ends here diff --git a/elpa/forge-20240523.1103/forge-core.el b/elpa/forge-20240523.1103/forge-core.el new file mode 100644 index 00000000..47b5b879 --- /dev/null +++ b/elpa/forge-20240523.1103/forge-core.el @@ -0,0 +1,395 @@ +;;; forge-core.el --- Core functionality -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2024 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . + +;;; Code: + +(require '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 \"/v3\" and whose GraphQL API's end point is + \"/graphql\", then use \"/v3\" as APIHOST. This is a + historic accident. See issue #174. + +- WEBHOST and CLASS cannot be changed once you have added one or + more repositories from a forge. Changing GITHOST and/or APIHOST + may be possible, but should seldom be necessary." + :package-version '(forge . "0.1.0") + :group 'forge + :type '(repeat (list (string :tag "Git host") + (choice (string :tag "API endpoint") + (const :tag "No API" nil)) + (string :tag "ID") + (symbol :tag "Repository class")))) + +;;; Class + +(defclass forge-object (closql-object) () :abstract t) + +(defmacro forge--childp (obj type) + "Somewhat similar to `cl-typep' but only for (possibly unknown) classes. +TYPE is evaluated at macro-expansion time but unlike with +`cl-typep' the respective class does not have to be defined +at that time." + (let ((fn (intern (concat (symbol-name (eval type)) "--eieio-childp")))) + `(and (fboundp ',fn) (,fn ,obj)))) + +;;; Query + +(cl-defgeneric forge-get-parent (object) + "Return the parent object of OBJECT. +The hierarchy is repository > topic > post. +For other objects return nil.") + +(cl-defgeneric forge-get-repository (demand) + "Return a forge repository object or nil, or signal an error. + +A forge repository is a repository hosted on a forge. The local clone +is also a \"repository\", but it is a \"Git\" repository, not a \"Forge\" +repository. (Forge repositories are also Git repositories, but not the +other way around.) + +A `:known' repository has an entry in the local database. All other +repositories are unknown. `:known' repositories are devided into two +subgroups: `:tracked' and \"untracked\" repositories. + +A `:tracked' repository was previously explicitly added to the database +by the user. + +When Forge encounters a repository, without being instructed by the user +to track it, it may nevertheless add limited information about it to the +database. Such a repository is `:known' but it is not `:tracked'. + +Other repositories are \"unknown\". Most commands can only deal with +repositories that are stored in the database. Of these, some can deal +with any `:known' repositories, others require that they are `:tracked'. + +Some other commands exist — such as the browse commands — that have no +such requirement. While such commands also require a repository object, +they do not care whether that is stored in the database. Instead they +are happy to use a `:stub' repository; a repository that is not stored +in the database. + +The DEMAND argument specifies what kind of repository object the caller +requires, at least. `:tracked' is greater than `:known', which is +greater than `:stub'. For example, if the caller requests a `:known' +repository, a `:tracked' repository will do, while a `:stub' repository +will not. + +The valid values for DEMAND are: + +- `:tracked' and `:tracked?' request a repository that the user added + to the database. If there is no such repository, the former causes + an error to be signaled, while for the latter nil is returned. + +- `:known?' and `:insert!' request a repository from the database. + Whether the user explicitly added it does not matter. If there is no + such repository, nil is returned for the former, while for the latter + a new repository is inserted into the repository and then returned. + +- `:stub' and `:stub?' request the Forge repository corresponding to + the current Git repository. It does not matter whether it is known. + This fails if `default-directory' is not inside a Git repository, if + there is no matching entry in `forge-alist', or if it is unclear which + remote to use. If the repository cannot be determined, the former + causes an error to be signaled, while for the latter nil is returned. + + Stub repository objects are created without making an API request, so + we lack access to the upstream ID, which the IDs used in out database, + derive from. Stub repositories are \"unknown\" in the sense that their + IDs are not `:known'. This is done to allow offline operations. + +- `:valid?' requests the Forge repository corresponding to the current + Git repository. It does not matter whether it is known. If it is + unknown, an API request is made to verify that the repository exists + on the forge. If it does, an object with a valid upstream ID is + returned, but that isn't inserted into the database. If not, nil is + returned. + +Given a repository object, you can query its `condition' slot to learn +whether it is `:tracked', `:known' (i.e., has a valid ID and is stored +in the database), or merely a `:stub'. + +You can also use (forge-get repository OBJECT nil DEMAND) to check the +condition of a repository object, or even to ensure a repository object +has a valid upstream ID (using `:valid?'), or that it is tracked in the +database (using `:insert!'). + +Use `forge-repository-equal' to check if two objects refer to the same +repository. + +Also see info node `(forge) Repository Detection'.") + +(cl-defgeneric forge-get-topic () + "Return a forge issue or pullreq object.") + +(cl-defgeneric forge-get-issue () + "Return a forge issue object.") + +(cl-defgeneric forge-get-pullreq () + "Return a forge pullreq object.") + +(defun forge--get-forge-host (host &optional demand) + "Return `forge-alist' entry matching HOST. + +Entries have the form (GITHOST APIHOST WEBHOST CLASS). + +- If HOST matches a GITHOST, return the corresponding entry. +- Else, if HOST is an ssh alias and the canonical hostname matches a + GITHOST, return the corresponding entry. +- Finally, if HOST matches a WEBHOST, return the corresponding entry + +If no entry matches, return nil, or signal an error if optional DEMAND +is non-nil." + (or (assoc host forge-alist) + (assoc (seq-some (lambda (line) + (and (string-prefix-p "hostname" line) + (substring line 9))) + (ignore-errors + (process-lines-ignore-status "ssh" "-G" host))) + forge-alist) + (car (cl-member host forge-alist :test #'equal :key #'caddr)) + (and demand + (error "No entry for \"%s\" in `forge-alist'" host)))) + +(defun forge--split-forge-url (url) + (save-match-data + (and (string-match + (concat "\\`" + "\\(?:git://\\|" + "[^/@]+@\\|" + "\\(?:ssh\\|ssh\\+git\\|git\\+ssh\\)://\\(?:[^/@]+@\\)?\\|" + "https?://\\(?:[^/@]+@\\)?\\)?" + (regexp-opt (mapcar #'car forge-alist) t) + "\\(?::[0-9]+\\)?" + "\\(?:/\\|:/?\\)" + "~?\\(.+?\\)/" + "\\([^/]+?\\)" + "\\(?:\\.git\\|/\\)?" + "\\'") + url) + (list (caddr (forge--get-forge-host (match-string 1 url) t)) + (match-string 2 url) + (match-string 3 url))))) + +;;; Identity + +(cl-defgeneric forge--object-id (class &rest args) + "Return the database id for the CLASS object specified by ARGS.") + +(cl-defgeneric forge--repository-ids ( class host owner name + &optional stub noerror) + "Return the database and forge ids for the specified CLASS object.") + +(cl-defmethod magit-section-ident-value ((obj forge-object)) + "Return the value ob OBJ's `id' slot. +Using OBJ itself would not be appropriate because multiple +non-equal objects may exist, representing the same thing." + (oref obj id)) + +(defun forge--set-id-slot (repo object slot rows) + "Set the value in OBJECT for SLOT to VALUE, actually storing foreign keys." + ;; TODO Should CloSQL advice `oset' to make this unnecessary? + (let ((repo-id (oref repo id))) + (closql-oset + object slot + (mapcar (lambda (val) + (forge--object-id repo-id + (if (atom val) val (alist-get 'id val)))) + rows)))) + +;;; Format + +(cl-defgeneric forge--format (object slot &optional spec) + "Return a string based on SPEC and the format-string in OBJECT's SLOT. +The available `format'-like specs depend on the type of OBJECT. +SPEC can be used to add additional specs, as for `format-spec'. +The latter override the former. SLOT is expected to be class- +allocated. Some methods also accept a format string in place +of SLOT.") + +(cl-defmethod forge--format-resource ((object forge-object) resource) + "Return an API resource based on RESOURCE and slots of OBJECT. +For use in `forge--FORGE-METHOD' such as `forge--ghub-get'. +RESOURCE is a string separated by slashes. Each part that begins +with a colon is replaced with a value from OBJECT. `:repo' is a +synonym for `:name'. `:project' is a like `:owner/:name', but the +slash is quoted on Gitlab. `:topic' is a synonym for `:number' +but only if OBJECT is a topic. Any other `:SLOT' means to use +the value of that slot in OBJECT, or if that doesn't exist in its +parent object (determined using `forge-get-parent')." + (save-match-data + (setq resource + (replace-regexp-in-string + ":\\([^/]+\\)" + (lambda (str) + (let ((slot (intern (substring str 1)))) + (or (and-let* + ((v (ignore-errors + (pcase slot + ('repo (oref object name)) + ('project (concat (string-replace + "/" "%2F" (oref object owner)) + "%2F" + (oref object name))) + ('topic (and (forge--childp object 'forge-topic) + (oref object number))) + (_ (eieio-oref object slot)))))) + (format "%s" v)) + str))) + resource t t)) + (if (string-match ":[^/]*" resource) + (if-let ((parent (ignore-errors (forge-get-parent object)))) + (forge--format-resource parent resource) + (error "Cannot resolve %s for a %s" + (match-string 0 resource) + (eieio-object-class object))) + resource))) + +;;; Miscellaneous + +(defun forge-refresh-buffer (&optional buffer) + "Refresh the current buffer, if it is a Magit or Forge buffer. +Refresh the buffer if its major-mode derives from `magit-mode', +`forge-topic-list-mode' or `forge-repository-list-mode'. If +optional BUFFER is non-nil, then refresh that buffer, provided +it is alive and satisfies the mode requirement." + (cond (buffer + (when (buffer-live-p buffer) + (with-current-buffer buffer + (forge-refresh-buffer)))) + ((derived-mode-p 'forge-topic-mode) + (magit-refresh-buffer)) + ((derived-mode-p 'magit-mode) + (magit-refresh-buffer)) + ((derived-mode-p 'forge-topic-list-mode + 'forge-repository-list-mode) + (revert-buffer)))) + +(defun forge--sanitize-string (string) + ;; For Gitlab this may also be nil. + (if string (string-replace "\r\n" "\n" string) "")) + +(defun forge--uuid () + "Return string with random (version 4) UUID." + ;; This is a copy of `org-id-uuid'. + ;; Only used in `forge-create-mark'. + (let ((rnd (md5 (format "%s%s%s%s%s%s%s" + (random) + (current-time) + (user-uid) + (emacs-pid) + (user-full-name) + user-mail-address + (recent-keys))))) + (format "%s-%s-4%s-%s%s-%s" + (substring rnd 0 8) + (substring rnd 8 12) + (substring rnd 13 16) + (format "%x" + (logior + #b10000000 + (logand + #b10111111 + (string-to-number + (substring rnd 16 18) 16)))) + (substring rnd 18 20) + (substring rnd 20 32)))) + +;;; _ +(provide 'forge-core) +;;; forge-core.el ends here diff --git a/elpa/forge-20240523.1103/forge-db.el b/elpa/forge-20240523.1103/forge-db.el new file mode 100644 index 00000000..f7df96b4 --- /dev/null +++ b/elpa/forge-20240523.1103/forge-db.el @@ -0,0 +1,549 @@ +;;; forge-db.el --- Database implementation -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2024 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . + +;;; Code: + +(require 'closql) +(require 'compat) +(require 'eieio) +(require 'emacsql) + +;; For `closql--db-update-schema': +(declare-function forge--object-id "forge-core") +(declare-function forge-get-issue "forge-core") +(declare-function forge-get-pullreq "forge-core") +(declare-function forge-get-repository "forge-core" (demand)) + +(eval-when-compile + (cl-pushnew 'number eieio--known-slot-names) + (cl-pushnew 'value eieio--known-slot-names)) + +;;; Options + +(defcustom forge-database-file + (expand-file-name "forge-database.sqlite" user-emacs-directory) + "The file used to store the forge database." + :package-version '(forge . "0.1.0") + :group 'forge + :type 'file) + +;;; Core + +(defclass forge-database (closql-database) + ((name :initform "Forge") + (object-class :initform 'forge-repository) + (file :initform 'forge-database-file) + (schemata :initform 'forge--db-table-schemata) + (version :initform 13))) + +(defvar forge--override-connection-class nil) + +(defun forge-db (&optional livep) + (closql-db 'forge-database livep forge--override-connection-class)) + +(defun forge-sql (sql &rest args) + (if (stringp sql) + (emacsql (forge-db) (apply #'format sql args)) + (apply #'emacsql (forge-db) sql args))) + +(defun forge-connect-database-once () + "Try to connect Forge database on first use of `magit-status' only." + (remove-hook 'magit-status-mode-hook #'forge-connect-database-once) + (forge-db)) +(add-hook 'magit-status-mode-hook #'forge-connect-database-once) + +(defun forge-enable-sql-logging () + "Enable logging Forge's SQL queries." + (interactive) + (let ((conn (oref (forge-db) connection))) + (emacsql-enable-debugging conn) + (switch-to-buffer-other-window (oref conn log-buffer)))) + +;;; Schemata + +(defconst forge--db-table-schemata + '((repository + [(class :not-null) + (id :not-null :primary-key) + forge-id + forge + owner + name + apihost + githost + remote + condition + created + updated + pushed + parent + description + homepage + default-branch + archived-p + fork-p + locked-p + mirror-p + private-p + issues-p + wiki-p + stars + watchers + (assignees :default eieio-unbound) + (forks :default eieio-unbound) + (issues :default eieio-unbound) + (labels :default eieio-unbound) + (revnotes :default eieio-unbound) + (pullreqs :default eieio-unbound) + selective-p + worktree + (milestones :default eieio-unbound) + issues-until + pullreqs-until + ]) + + (assignee + [(repository :not-null) + (id :not-null :primary-key) + login + name + forge-id] ; Needed for Gitlab. + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (fork + [(parent :not-null) + (id :not-null :primary-key) + owner + name] + (:foreign-key + [parent] :references repository [id] + :on-delete :cascade)) + + (issue + [(class :not-null) + (id :not-null :primary-key) + repository + number + state + author + title + created + updated + closed + status + locked-p + milestone + body + (assignees :default eieio-unbound) + (cards :default eieio-unbound) + (edits :default eieio-unbound) + (labels :default eieio-unbound) + (participants :default eieio-unbound) + (posts :default eieio-unbound) + (reactions :default eieio-unbound) + (timeline :default eieio-unbound) + (marks :default eieio-unbound) + note + their-id + slug + saved-p] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (issue-assignee + [(issue :not-null) + (id :not-null)] + (:foreign-key + [issue] :references issue [id] + :on-delete :cascade)) + + (issue-label + [(issue :not-null) + (id :not-null)] + (:foreign-key + [issue] :references issue [id] + :on-delete :cascade) + (:foreign-key + [id] :references label [id] + :on-delete :cascade)) + + (issue-mark + [(issue :not-null) + (id :not-null)] + (:foreign-key + [issue] :references issue [id] + :on-delete :cascade) + (:foreign-key + [id] :references mark [id] + :on-delete :cascade)) + + (issue-post + [(class :not-null) + (id :not-null :primary-key) + issue + number + author + created + updated + body + (edits :default eieio-unbound) + (reactions :default eieio-unbound)] + (:foreign-key + [issue] :references issue [id] + :on-delete :cascade)) + + (label + [(repository :not-null) + (id :not-null :primary-key) + name + color + description] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (mark + [;; For now this is always nil because it seems more useful to + ;; share marks between repositories. We cannot omit this slot + ;; though because `closql--iref' expects `id' to be the second + ;; slot. + repository + (id :not-null :primary-key) + name + face + description]) + + (milestone + [(repository :not-null) + (id :not-null :primary-key) + number + title + created + updated + due + closed + description] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (notification + [(class :not-null) + (id :not-null :primary-key) + thread-id + repository + type + topic + url + title + reason + last-read + updated] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (pullreq + [(class :not-null) + (id :not-null :primary-key) + repository + number + state + author + title + created + updated + closed + merged + status + locked-p + editable-p + cross-repo-p + base-ref + base-repo + head-ref + head-user + head-repo + milestone + body + (assignees :default eieio-unbound) + (cards :default eieio-unbound) + (commits :default eieio-unbound) + (edits :default eieio-unbound) + (labels :default eieio-unbound) + (participants :default eieio-unbound) + (posts :default eieio-unbound) + (reactions :default eieio-unbound) + (review-requests :default eieio-unbound) + (reviews :default eieio-unbound) + (timeline :default eieio-unbound) + (marks :default eieio-unbound) + note + base-rev + head-rev + draft-p + their-id + slug + saved-p] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (pullreq-assignee + [(pullreq :not-null) + (id :not-null)] + (:foreign-key + [pullreq] :references pullreq [id] + :on-delete :cascade)) + + (pullreq-label + [(pullreq :not-null) + (id :not-null)] + (:foreign-key + [pullreq] :references pullreq [id] + :on-delete :cascade) + (:foreign-key + [id] :references label [id] + :on-delete :cascade)) + + (pullreq-mark + [(pullreq :not-null) + (id :not-null)] + (:foreign-key + [pullreq] :references pullreq [id] + :on-delete :cascade) + (:foreign-key + [id] :references mark [id] + :on-delete :cascade)) + + (pullreq-post + [(class :not-null) + (id :not-null :primary-key) + pullreq + number + author + created + updated + body + (edits :default eieio-unbound) + (reactions :default eieio-unbound)] + (:foreign-key + [pullreq] :references pullreq [id] + :on-delete :cascade)) + + (pullreq-review-request + [(pullreq :not-null) + (id :not-null)] + (:foreign-key + [pullreq] :references pullreq [id] + :on-delete :cascade)) + + (revnote + [(class :not-null) + (id :not-null :primary-key) + repository + commit + file + line + author + body] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)))) + +(cl-defmethod closql--db-update-schema ((db forge-database)) + (let ((code-version (oref-default 'forge-database version)) + (version (closql--db-get-version db))) + (when (< version code-version) + (forge--backup-database db)) + (closql-with-transaction db + (when (= version 2) + (message "Upgrading Forge database from version 2 to 3...") + (emacsql db [:create-table pullreq-review-request $S1] + (cdr (assq 'pullreq-review-request forge--db-table-schemata))) + (closql--db-set-version db (setq version 3)) + (message "Upgrading Forge database from version 2 to 3...done")) + (when (= version 3) + (message "Upgrading Forge database from version 3 to 4...") + (emacsql db [:drop-table notification]) + (pcase-dolist (`(,table . ,schema) forge--db-table-schemata) + (when (memq table '(notification + mark issue-mark pullreq-mark)) + (emacsql db [:create-table $i1 $S2] table schema))) + (emacsql db [:alter-table issue :add-column marks :default $s1] 'eieio-unbound) + (emacsql db [:alter-table pullreq :add-column marks :default $s1] 'eieio-unbound) + (closql--db-set-version db (setq version 4)) + (message "Upgrading Forge database from version 3 to 4...done")) + (when (= version 4) + (message "Upgrading Forge database from version 4 to 5...") + (emacsql db [:alter-table repository :add-column selective-p :default nil]) + (closql--db-set-version db (setq version 5)) + (message "Upgrading Forge database from version 4 to 5...done")) + (when (= version 5) + (message "Upgrading Forge database from version 5 to 6...") + (emacsql db [:alter-table repository :add-column worktree :default nil]) + (closql--db-set-version db (setq version 6)) + (message "Upgrading Forge database from version 5 to 6...done")) + (when (= version 6) + (message "Upgrading Forge database from version 6 to 7...") + (emacsql db [:alter-table issue :add-column note :default nil]) + (emacsql db [:alter-table pullreq :add-column note :default nil]) + (emacsql db [:create-table milestone $S1] + (cdr (assq 'milestone forge--db-table-schemata))) + (emacsql db [:alter-table repository :add-column milestones :default $s1] + 'eieio-unbound) + (pcase-dolist (`(,repo-id ,issue-id ,milestone) + (emacsql db [:select [repository id milestone] + :from issue + :where (notnull milestone)])) + (unless (stringp milestone) + (oset (forge-get-issue issue-id) milestone + (forge--object-id repo-id (cdar milestone))))) + (pcase-dolist (`(,repo-id ,pullreq-id ,milestone) + (emacsql db [:select [repository id milestone] + :from pullreq + :where (notnull milestone)])) + (unless (stringp milestone) + (oset (forge-get-pullreq pullreq-id) milestone + (forge--object-id repo-id (cdar milestone))))) + (closql--db-set-version db (setq version 7)) + (message "Upgrading Forge database from version 6 to 7...done")) + (when (= version 7) + (message "Upgrading Forge database from version 7 to 8...") + (emacsql db [:alter-table pullreq :add-column base-rev :default nil]) + (emacsql db [:alter-table pullreq :add-column head-rev :default nil]) + (emacsql db [:alter-table pullreq :add-column draft-p :default nil]) + (closql--db-set-version db (setq version 8)) + (message "Upgrading Forge database from version 7 to 8...done")) + (when (= version 8) + (message "Upgrading Forge database from version 8 to 9...") + (emacsql db [:alter-table pullreq :add-column their-id :default nil]) + (emacsql db [:alter-table issue :add-column their-id :default nil]) + (closql--db-set-version db (setq version 9)) + (message "Upgrading Forge database from version 8 to 9...done")) + (when (= version 9) + (message "Upgrading Forge database from version 9 to 10...") + (emacsql db [:alter-table pullreq :add-column slug :default nil]) + (emacsql db [:alter-table issue :add-column slug :default nil]) + (pcase-dolist (`(,id ,number ,type) + (emacsql + db + [:select [pullreq:id pullreq:number repository:class] + :from pullreq + :join repository + :on (= pullreq:repository repository:id)])) + (let ((gitlabp (memq type + (append (closql-where-class-in + 'forge-gitlab-repository--eieio-childp) + nil)))) + (emacsql db [:update pullreq :set (= slug $s1) :where (= id $s2)] + (format "%s%s" (if gitlabp "!" "#") number) + id))) + (pcase-dolist (`(,id ,number) + (emacsql db [:select [id number] :from issue])) + (emacsql db [:update issue :set (= slug $s1) :where (= id $s2)] + (format "#%s" number) + id)) + (closql--db-set-version db (setq version 10)) + (message "Upgrading Forge database from version 9 to 10...done")) + (when (= version 10) + (message "Upgrading Forge database from version 10 to 11...") + (emacsql db [:drop-table notification]) + (emacsql db [:create-table notification $S1] + (cdr (assq 'notification forge--db-table-schemata))) + (emacsql db [:alter-table pullreq :rename-column unread-p :to status]) + (emacsql db [:alter-table issue :rename-column unread-p :to status]) + (emacsql db [:alter-table pullreq :add-column saved-p :default nil]) + (emacsql db [:alter-table issue :add-column saved-p :default nil]) + (closql--db-set-version db (setq version 11)) + (message "Upgrading Forge database from version 10 to 11...done")) + (when (= version 11) + (message "Upgrading Forge database from version 11 to 12...") + (emacsql db [:drop-table notification]) + (emacsql db [:create-table notification $S1] + (cdr (assq 'notification forge--db-table-schemata))) + (dolist (id (emacsql db [:select id :from issue :where (= state 'closed)])) + (emacsql db [:update issue :set (= state 'completed) :where (= id $s1)] + id)) + (dolist (id (emacsql db [:select id :from issue :where (isnull status)])) + (emacsql db [:update issue :set (= state 'done) :where (= id $s1)] + id)) + (dolist (id (emacsql db [:select id :from pullreq :where (= state 'closed)])) + (emacsql db [:update pullreq :set (= state 'rejected) :where (= id $s1)] + id)) + (dolist (id (emacsql db [:select id :from pullreq :where (isnull status)])) + (emacsql db [:update pullreq :set (= state 'done) :where (= id $s1)] + id)) + (emacsql db [:alter-table repository :add-column issues-until :default nil]) + (emacsql db [:alter-table repository :add-column pullreqs-until :default nil]) + (closql--db-set-version db (setq version 12)) + (message "Upgrading Forge database from version 11 to 12...done")) + (when (= version 12) + (message "Upgrading Forge database from version 12 to 13...") + (dolist (id (emacsql db [:select id :from repository + :where (isnull issues-until)])) + (emacsql + db [:update repository :set (= issues-until $s1) :where (= id $s2)] + (caar (forge-sql [:select [updated] :from issue + :where (= repository $s1) + :order-by [(desc updated)] + :limit 1] + id)) + id)) + (dolist (id (emacsql db [:select id :from repository + :where (isnull pullreqs-until)])) + (emacsql + db [:update repository :set (= pullreqs-until $s1) :where (= id $s2)] + (caar (forge-sql [:select [updated] :from pullreq + :where (= repository $s1) + :order-by [(desc updated)] + :limit 1] + id)) + id)) + (emacsql db [:alter-table repository :rename-column sparse-p :to condition]) + (pcase-dolist (`(,id ,not-tracked) + (emacsql db [:select [id condition] :from repository])) + (emacsql + db [:update repository :set (= condition $s1) :where (= id $s2)] + (if not-tracked :known :tracked) + id)) + (closql--db-set-version db (setq version 13)) + (message "Upgrading Forge database from version 12 to 13...done")) + ) + (cl-call-next-method))) + +(defun forge--backup-database (db) + (let ((dst (concat (file-name-sans-extension forge-database-file) + (format "-v%s" (caar (emacsql (oref db connection) + [:pragma user-version]))) + (format-time-string "-%Y%m%d-%H%M") + ".sqlite"))) + (message "Copying Forge database to %s..." dst) + (copy-file forge-database-file dst) + (message "Copying Forge database to %s...done" dst))) + +;;; _ +(provide 'forge-db) +;;; forge-db.el ends here diff --git a/elpa/forge-20240523.1103/forge-gitea.el b/elpa/forge-20240523.1103/forge-gitea.el new file mode 100644 index 00000000..a12881fa --- /dev/null +++ b/elpa/forge-20240523.1103/forge-gitea.el @@ -0,0 +1,47 @@ +;;; forge-gitea.el --- Gitea support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2024 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . + +;;; Code: + +(require '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 diff --git a/elpa/forge-20240523.1103/forge-github.el b/elpa/forge-20240523.1103/forge-github.el new file mode 100644 index 00000000..8b807082 --- /dev/null +++ b/elpa/forge-20240523.1103/forge-github.el @@ -0,0 +1,858 @@ +;;; forge-github.el --- Github support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2024 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . + +;;; Code: + +(require 'ghub) + +(require 'forge) +(require 'forge-issue) +(require 'forge-pullreq) + +;;; Class + +(defclass forge-github-repository (forge-repository) + ((issues-url-format :initform "https://%h/%o/%n/issues") + (issue-url-format :initform "https://%h/%o/%n/issues/%i") + (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#issuecomment-%I") + (pullreqs-url-format :initform "https://%h/%o/%n/pulls") + (pullreq-url-format :initform "https://%h/%o/%n/pull/%i") + (pullreq-post-url-format :initform "https://%h/%o/%n/pull/%i#issuecomment-%I") + (commit-url-format :initform "https://%h/%o/%n/commit/%r") + (branch-url-format :initform "https://%h/%o/%n/commits/%r") + (remote-url-format :initform "https://%h/%o/%n") + (create-issue-url-format :initform "https://%h/%o/%n/issues/new") + (create-pullreq-url-format :initform "https://%h/%o/%n/compare") + (pullreq-refspec :initform "+refs/pull/*/head:refs/pullreqs/*"))) + +;;; Query + +(defun forge--get-github-repository () + (forge-github-repository-p (forge-get-repository :stub?))) + +;;; Pull +;;;; Repository + +(cl-defmethod forge--pull ((repo forge-github-repository) + &optional callback since) + (cl-assert (not (and since (forge-get-repository repo nil :tracked?)))) + (setq forge--mode-line-buffer (current-buffer)) + (forge--msg repo t nil "Pulling REPO") + (let ((buf (current-buffer))) + (ghub-fetch-repository + (oref repo owner) + (oref repo name) + (lambda (data) + (forge--msg repo t t "Pulling REPO") + (forge--msg repo t nil "Storing REPO") + (closql-with-transaction (forge-db) + (let-alist data + (forge--update-repository repo data) + (forge--update-assignees repo .assignableUsers) + (forge--update-forks repo .forks) + (forge--update-labels repo .labels) + (forge--update-milestones repo .milestones) + (forge--update-issues repo .issues t) + (forge--update-pullreqs repo .pullRequests t) + (forge--update-revnotes repo .commitComments)) + (oset repo condition :tracked)) + (forge--msg repo t t "Storing REPO") + (cond + ((oref repo selective-p)) + (callback (funcall callback)) + ((forge--maybe-git-fetch repo buf)))) + `((issues-until . ,(or since (oref repo issues-until))) + (pullRequests-until . ,(or since (oref repo pullreqs-until)))) + :host (oref repo apihost) + :auth 'forge + :sparse (oref repo selective-p)))) + +(cl-defmethod forge--update-repository ((repo forge-github-repository) data) + (let-alist data + (oset repo created .createdAt) + (oset repo updated .updatedAt) + (oset repo pushed .pushedAt) + (oset repo parent .parent.nameWithOwner) + (oset repo description .description) + (oset repo homepage (and (not (equal .homepageUrl "")) .homepageUrl)) + (oset repo default-branch .defaultBranchRef.name) + (oset repo archived-p .isArchived) + (oset repo fork-p .isFork) + (oset repo locked-p .isLocked) + (oset repo mirror-p .isMirror) + (oset repo private-p .isPrivate) + (oset repo issues-p .hasIssuesEnabled) + (oset repo wiki-p .hasWikiEnabled) + (oset repo stars .stargazers.totalCount) + (oset repo watchers .watchers.totalCount))) + +(cl-defmethod forge--update-revnotes ((repo forge-github-repository) data) + (closql-with-transaction (forge-db) + (mapc (apply-partially #'forge--update-revnote repo) data))) + +(cl-defmethod forge--update-revnote ((repo forge-github-repository) data) + (closql-with-transaction (forge-db) + (let-alist data + (closql-insert + (forge-db) + (forge-revnote + :id (forge--object-id 'forge-revnote repo .id) + :repository (oref repo id) + :commit .commit.oid + :file .path + :line .position + :author .author.login + :body .body) + t)))) + +(cl-defmethod forge--update-assignees ((repo forge-github-repository) data) + (oset repo assignees + (with-slots (id) repo + (mapcar (lambda (row) + (let-alist row + (list (forge--object-id id .id) + .login + .name + .id))) + (delete-dups data))))) + +(cl-defmethod forge--update-forks ((repo forge-github-repository) data) + (oset repo forks + (with-slots (id) repo + (mapcar (lambda (row) + (let-alist row + (nconc (forge--repository-ids + (eieio-object-class repo) + (oref repo githost) + .owner.login + .name) + (list .owner.login + .name)))) + (delete-dups data))))) + +(cl-defmethod forge--update-labels ((repo forge-github-repository) data) + (oset repo labels + (with-slots (id) repo + (mapcar (lambda (row) + (let-alist row + (list (forge--object-id id .id) + .name + (concat "#" (downcase .color)) + .description))) + (delete-dups data))))) + +(cl-defmethod forge--update-milestones ((repo forge-github-repository) data) + (oset repo milestones + (with-slots (id) repo + (mapcar (lambda (row) + (let-alist row + (list (forge--object-id id .id) + .number + .title + .createdAt + .updatedAt + .dueOn + .closedAt + .description))) + (delete-dups data))))) + +;;;; Topics + +(cl-defmethod forge--pull-topic ((repo forge-github-repository) + (number number)) + (let ((id (oref repo id))) + (forge--pull-topic + repo + (forge-issue :repository id :number number) + :errorback (lambda (err _headers _status _req) + (when (equal (cdr (assq 'type (cadr err))) "NOT_FOUND") + (forge--pull-topic + repo + (forge-pullreq :repository id :number number))))))) + +(cl-defmethod forge--pull-topic ((repo forge-github-repository) + (topic forge-issue) + &key callback errorback) + (let ((buffer (current-buffer))) + (ghub-fetch-issue + (oref repo owner) + (oref repo name) + (oref topic number) + (lambda (data) + (forge--update-issue repo data) + (forge-refresh-buffer buffer) + (when callback (funcall callback))) + nil + :host (oref repo apihost) + :auth 'forge + :errorback errorback))) + +(cl-defmethod forge--pull-topic ((repo forge-github-repository) + (topic forge-pullreq) + &key callback errorback) + (let ((buffer (current-buffer))) + (ghub-fetch-pullreq + (oref repo owner) + (oref repo name) + (oref topic number) + (lambda (data) + (forge--update-pullreq repo data) + (forge-refresh-buffer buffer) + (when callback (funcall callback))) + nil + :host (oref repo apihost) + :auth 'forge + :errorback errorback))) + +(cl-defmethod forge--update-status ((repo forge-github-repository) + topic data bump initial-pull) + (let-alist data + (let ((updated (or .updatedAt .createdAt)) + (current-status (oref topic status))) + (cond ((not .isReadByViewer) + (oset topic status 'unread)) + (initial-pull + (oset topic status 'done)) + ((null current-status) + (oset topic status 'pending)) + ((string> updated (oref topic updated)) + (oset topic status 'pending))) + (oset topic updated updated) + (when bump + (let* ((slot (if (forge-issue-p topic) 'issues-until 'pullreqs-until)) + (until (eieio-oref repo slot))) + (when (or (not until) (string> updated until)) + (eieio-oset repo slot updated))))))) + +;;;; Issues + +(cl-defmethod forge--update-issues ((repo forge-github-repository) data + &optional bump) + (closql-with-transaction (forge-db) + (let ((initial-pull (not (oref repo issues-until)))) + (mapc (lambda (e) (forge--update-issue repo e bump initial-pull)) data)))) + +(cl-defmethod forge--update-issue ((repo forge-github-repository) data + &optional bump initial-pull) + (let (issue-id issue) + (let-alist data + (closql-with-transaction (forge-db) + (setq issue-id (forge--object-id 'forge-issue repo .number)) + (setq issue (or (forge-get-issue repo .number) + (closql-insert + (forge-db) + (forge-issue :id issue-id + :repository (oref repo id) + :number .number)))) + (oset issue their-id .id) + (oset issue slug (format "#%s" .number)) + (oset issue state + (pcase-exhaustive (list .stateReason .state) + (`("COMPLETED" ,_) 'completed) + (`("NOT_PLANNED" ,_) 'unplanned) + (`(,_ "CLOSED") 'completed) + (`(,_ "OPEN") 'open))) + (oset issue author .author.login) + (oset issue title .title) + (oset issue created .createdAt) + (oset issue closed .closedAt) + (oset issue locked-p .locked) + (oset issue milestone (and .milestone.id + (forge--object-id (oref repo id) + .milestone.id))) + (oset issue body (forge--sanitize-string .body)) + (dolist (c .comments) + (let-alist c + (closql-insert + (forge-db) + (forge-issue-post + :id (forge--object-id issue-id .databaseId) + :issue issue-id + :number .databaseId + :author .author.login + :created .createdAt + :updated .updatedAt + :body (forge--sanitize-string .body)) + t))) + (forge--update-status repo issue data bump initial-pull)) + (ignore-errors + (forge--set-id-slot repo issue 'assignees .assignees)) + (ignore-errors + (unless (magit-get-boolean "forge.kludge-for-issue-294") + (forge--set-id-slot repo issue 'labels .labels)))) + issue)) + +;;;; Pullreqs + +(cl-defmethod forge--update-pullreqs ((repo forge-github-repository) data + &optional bump) + (closql-with-transaction (forge-db) + (let ((initial-pull (not (oref repo pullreqs-until)))) + (mapc (lambda (e) (forge--update-pullreq repo e bump initial-pull)) data)))) + +(cl-defmethod forge--update-pullreq ((repo forge-github-repository) data + &optional bump initial-pull) + (let (pullreq-id pullreq) + (let-alist data + (closql-with-transaction (forge-db) + (setq pullreq-id (forge--object-id 'forge-pullreq repo .number)) + (setq pullreq (or (forge-get-pullreq repo .number) + (closql-insert + (forge-db) + (forge-pullreq :id pullreq-id + :repository (oref repo id) + :number .number)))) + (oset pullreq their-id .id) + (oset pullreq slug (format "#%s" .number)) + (oset pullreq state (pcase-exhaustive .state + ("MERGED" 'merged) + ("CLOSED" 'rejected) + ("OPEN" 'open))) + (oset pullreq author .author.login) + (oset pullreq title .title) + (oset pullreq created .createdAt) + (oset pullreq closed .closedAt) + (oset pullreq merged .mergedAt) + (oset pullreq draft-p .isDraft) + (oset pullreq locked-p .locked) + (oset pullreq editable-p .maintainerCanModify) + (oset pullreq cross-repo-p .isCrossRepository) + (oset pullreq base-ref .baseRef.name) + (oset pullreq base-rev .baseRefOid) + (oset pullreq base-repo .baseRef.repository.nameWithOwner) + (oset pullreq head-ref .headRef.name) + (oset pullreq head-rev .headRefOid) + (oset pullreq head-user .headRef.repository.owner.login) + (oset pullreq head-repo .headRef.repository.nameWithOwner) + (oset pullreq milestone (and .milestone.id + (forge--object-id (oref repo id) + .milestone.id))) + (oset pullreq body (forge--sanitize-string .body)) + (dolist (p .comments) + (let-alist p + (closql-insert + (forge-db) + (forge-pullreq-post + :id (forge--object-id pullreq-id .databaseId) + :pullreq pullreq-id + :number .databaseId + :author .author.login + :created .createdAt + :updated .updatedAt + :body (forge--sanitize-string .body)) + t))) + (forge--update-status repo pullreq data bump initial-pull)) + (ignore-errors + (forge--set-id-slot repo pullreq 'assignees .assignees)) + (ignore-errors + (forge--set-id-slot repo pullreq 'review-requests + (--map (cdr (cadr (car it))) + .reviewRequests))) + (ignore-errors + (unless (magit-get-boolean "forge.kludge-for-issue-294") + (forge--set-id-slot repo pullreq 'labels .labels)))) + pullreq)) + +;;;; Notifications + +(cl-defmethod forge--pull-notifications + ((_class (subclass forge-github-repository)) githost &optional callback) + ;; The GraphQL API doesn't support notifications and also likes to + ;; timeout for handcrafted requests, forcing us to perform a major + ;; rain dance. + (let ((spec (forge--get-forge-host githost t))) + (forge--msg nil t nil "Pulling notifications") + (pcase-let* + ((`(,_ ,apihost ,forge ,_) spec) + (since (forge--ghub-notifications-since forge)) + (notifs + (seq-keep (lambda (data) + ;; Github returns notifications for repositories the + ;; user no longer has access to. Trying to retrieve + ;; information for such repositories leads to errors, + ;; which we suppress. See #164. + (with-demoted-errors "forge--pull-notifications: %S" + (forge--ghub-massage-notification data githost))) + (forge--ghub-get nil "/notifications" + `((all . t) ,@(and since `((since . ,since)))) + :host apihost :unpaginate t))) + (groups (-partition-all 50 notifs)) + (pages (length groups)) + (page 0) + (topics nil)) + (cl-labels + ((cb (&optional data _headers _status _req) + (when data + (setq topics (nconc topics (cdr data)))) + (if groups + (progn (cl-incf page) + (forge--msg nil t nil + "Pulling notifications (page %s/%s)" + page pages) + (ghub--graphql-vacuum + (cons 'query (seq-keep #'caddr (pop groups))) + nil #'cb nil :auth 'forge :host apihost)) + (forge--msg nil t t "Pulling notifications") + (forge--msg nil t nil "Storing notifications") + (forge--ghub-update-notifications notifs topics (not since)) + (forge--msg nil t t "Storing notifications") + (when callback + (funcall callback))))) + (cb))))) + +(defun forge--ghub-notifications-since (forge) + (caar (forge-sql [:select :distinct [notification:updated] + :from [notification repository] + :where (and (= repository:forge $s1) + (= repository:id notification:repository)) + :order-by [(desc notification:updated)]] + forge))) + +(defun forge--ghub-massage-notification (data githost) + (let-alist data + (let* ((type (intern (downcase .subject.type))) + (type (if (eq type 'pullrequest) 'pullreq type))) + (and (memq type '(pullreq issue)) + (let* ((number (and (string-match "[0-9]*\\'" .subject.url) + (string-to-number (match-string 0 .subject.url)))) + (repo (forge-get-repository + (list githost + .repository.owner.login + .repository.name) + nil :insert!)) + (repoid (oref repo id)) + (owner (oref repo owner)) + (name (oref repo name)) + (id (forge--object-id repoid (string-to-number .id))) + (alias (intern (concat "_" (string-replace "=" "_" id))))) + (list alias id + `((,alias repository) + [(name ,name) + (owner ,owner)] + ,@(cddr + (caddr + (ghub--graphql-prepare-query + ghub-fetch-repository + (if (eq type 'issue) + `(repository issues (issue . ,number)) + `(repository pullRequest (pullRequest . ,number))) + )))) + repo type data)))))) + +(defun forge--ghub-update-notifications (notifs topics initial-pull) + (closql-with-transaction (forge-db) + (pcase-dolist (`(,alias ,id ,_ ,repo ,type ,data) notifs) + (let-alist data + (let* ((topic (funcall (if (eq type 'issue) + #'forge--update-issue + #'forge--update-pullreq) + repo + (cdr (cadr (assq alias topics))) + nil initial-pull)) + (notif (or (forge-get-notification id) + (closql-insert (forge-db) + (forge-notification + :id id + :thread-id .id + :repository (oref repo id) + :type type + :topic (oref topic id) + :url .subject.url))))) + (oset notif title .subject.title) + (oset notif reason (intern (downcase .reason))) + (oset notif last-read .last_read_at) + (oset notif updated .updated_at)))))) + +;;;; Miscellaneous + +(cl-defmethod forge--add-user-repos + ((class (subclass forge-github-repository)) host user) + (forge--fetch-user-repos + class (forge--as-apihost host) user + (apply-partially #'forge--batch-add-callback (forge--as-githost host) user))) + +(cl-defmethod forge--add-organization-repos + ((class (subclass forge-github-repository)) host org) + (forge--fetch-organization-repos + class (forge--as-apihost host) org + (apply-partially #'forge--batch-add-callback (forge--as-githost host) org))) + +(cl-defmethod forge--fetch-user-repos + ((_ (subclass forge-github-repository)) host user callback) + (ghub--graphql-vacuum + '(query (user + [(login $login String!)] + (repositories + [(:edges t) + (ownerAffiliations . (OWNER))] + name))) + `((login . ,user)) + (lambda (d) + (funcall callback + (--map (alist-get 'name it) + (let-alist d .user.repositories)))) + nil :auth 'forge :host host)) + +(cl-defmethod forge--fetch-organization-repos + ((_ (subclass forge-github-repository)) host org callback) + (ghub--graphql-vacuum + '(query (organization + [(login $login String!)] + (repositories [(:edges t)] name))) + `((login . ,org)) + (lambda (d) + (funcall callback + (--map (alist-get 'name it) + (let-alist d .organization.repositories)))) + nil :auth 'forge :host host)) + +(defun forge--batch-add-callback (host owner names) + (let ((repos (cl-mapcan + (lambda (name) + (let ((repo (forge-get-repository + (list host owner name) + nil :insert!))) + (and (not (forge-get-repository repo nil :tracked?)) + (list repo)))) + names)) + (cb nil)) + (setq cb (lambda () + (when-let ((repo (pop repos))) + (forge--pull repo cb)))) + (funcall cb))) + +;;; Mutations + +(cl-defmethod forge--submit-create-issue ((_ forge-github-repository) repo) + (let-alist (forge--topic-parse-buffer) + (forge--ghub-post repo "/repos/:owner/:repo/issues" + `((title . , .title) + (body . , .body) + ,@(and .labels (list (cons 'labels .labels))) + ,@(and .assignees (list (cons 'assignees .assignees)))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback)))) + +(cl-defmethod forge--create-pullreq-from-issue ((repo forge-github-repository) + (issue forge-issue) + source target) + (pcase-let* ((`(,base-remote . ,base-branch) + (magit-split-branch-name target)) + (`(,head-remote . ,head-branch) + (magit-split-branch-name source)) + (head-repo (forge-get-repository :stub head-remote))) + (forge--ghub-post repo "/repos/:owner/:repo/pulls" + `((issue . ,(oref issue number)) + (base . ,base-branch) + (head . ,(if (equal head-remote base-remote) + head-branch + (concat (oref head-repo owner) ":" + head-branch))) + (maintainer_can_modify . t)) + :callback (lambda (&rest _) + (closql-delete issue) + (forge-pull)) + :errorback (lambda (&rest _) (forge-pull))))) + +(cl-defmethod forge--submit-create-pullreq ((_ forge-github-repository) repo) + (let-alist (forge--topic-parse-buffer) + (when (and .yaml (local-variable-p 'forge-buffer-draft-p)) + (user-error "Cannot use yaml frontmatter and set `%s' at the same time" + 'forge-buffer-draft-p)) + (pcase-let* ((`(,base-remote . ,base-branch) + (magit-split-branch-name forge--buffer-base-branch)) + (`(,head-remote . ,head-branch) + (magit-split-branch-name forge--buffer-head-branch)) + (head-repo (forge-get-repository :stub head-remote)) + (url-mime-accept-string + ;; Support draft pull-requests. + "application/vnd.github.shadow-cat-preview+json")) + (forge--ghub-post repo "/repos/:owner/:repo/pulls" + `((title . , .title) + (body . , .body) + (base . ,base-branch) + (head . ,(if (equal head-remote base-remote) + head-branch + (concat (oref head-repo owner) ":" + head-branch))) + (draft . ,(if (local-variable-p 'forge-buffer-draft-p) + forge-buffer-draft-p + .draft)) + (maintainer_can_modify . t)) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))))) + +(cl-defmethod forge--submit-create-post ((_ forge-github-repository) topic) + (forge--ghub-post topic "/repos/:owner/:repo/issues/:number/comments" + `((body . ,(string-trim (buffer-string)))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))) + +(cl-defmethod forge--submit-edit-post ((_ forge-github-repository) post) + (forge--ghub-patch post + (cl-typecase post + (forge-pullreq "/repos/:owner/:repo/pulls/:number") + (forge-issue "/repos/:owner/:repo/issues/:number") + (forge-post "/repos/:owner/:repo/issues/comments/:number")) + (if (cl-typep post 'forge-topic) + (let-alist (forge--topic-parse-buffer) + `((title . , .title) + (body . , .body))) + `((body . ,(string-trim (buffer-string))))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))) + +(cl-defmethod forge--set-topic-title + ((_repo forge-github-repository) topic title) + (forge--ghub-patch topic + "/repos/:owner/:repo/issues/:number" + `((title . ,title)) + :callback (forge--set-field-callback topic))) + +(cl-defmethod forge--set-topic-state + ((_repo forge-github-repository) topic state) + (forge--ghub-patch topic + "/repos/:owner/:repo/issues/:number" + (pcase-exhaustive state + ;; Merging isn't done through here. + ('completed '((state . "closed") (state_reason . "completed"))) + ('unplanned '((state . "closed") (state_reason . "not_planned"))) + ('rejected '((state . "closed"))) + ('open '((state . "open")))) + :callback (forge--set-field-callback topic))) + +(cl-defmethod forge--set-topic-draft + ((_repo forge-github-repository) topic value) + (let ((buffer (current-buffer))) + (ghub-graphql + `(mutation (,(if value + 'convertPullRequestToDraft + 'markPullRequestReadyForReview) + [(input $input ,(if value + 'ConvertPullRequestToDraftInput! + 'MarkPullRequestReadyForReviewInput!))] + (pullRequest isDraft))) + `((input (pullRequestId . ,(oref topic their-id)))) + :host (oref (forge-get-repository topic) apihost) + :auth 'forge + :callback (lambda (data &rest _) + (if (assq 'error data) + (ghub--graphql-pp-response data) + (oset topic draft-p value) + (forge-refresh-buffer buffer)))))) + +(cl-defmethod forge--set-topic-milestone + ((repo forge-github-repository) topic milestone) + (forge--ghub-patch topic + "/repos/:owner/:repo/issues/:number" + (if milestone + `((milestone . ,(caar (forge-sql [:select [number] + :from milestone + :where (and (= repository $s1) + (= title $s2))] + (oref repo id) + milestone)))) + `((milestone . :null))) + :callback (forge--set-field-callback topic))) + +(cl-defmethod forge--set-topic-labels + ((_repo forge-github-repository) topic labels) + (funcall (if labels #'forge--ghub-put #'forge--ghub-delete) + topic "/repos/:owner/:repo/issues/:number/labels" nil + :payload labels + :callback (forge--set-field-callback topic))) + +(cl-defmethod forge--set-topic-assignees + ((_repo forge-github-repository) topic assignees) + (let ((value (mapcar #'car (closql--iref topic 'assignees)))) + ;; FIXME Only refresh once. + (when-let ((add (cl-set-difference assignees value :test #'equal))) + (forge--ghub-post topic "/repos/:owner/:repo/issues/:number/assignees" + `((assignees . ,add)) + :callback (forge--set-field-callback topic))) + (when-let ((remove (cl-set-difference value assignees :test #'equal))) + (forge--ghub-delete topic "/repos/:owner/:repo/issues/:number/assignees" + `((assignees . ,remove)) + :callback (forge--set-field-callback topic))))) + +(cl-defmethod forge--set-topic-review-requests + ((_repo forge-github-repository) topic reviewers) + (let ((value (mapcar #'car (closql--iref topic 'review-requests)))) + ;; FIXME Only refresh once. + (when-let ((add (cl-set-difference reviewers value :test #'equal))) + (forge--ghub-post topic + "/repos/:owner/:repo/pulls/:number/requested_reviewers" + `((reviewers . ,add)) + :callback (forge--set-field-callback topic))) + (when-let ((remove (cl-set-difference value reviewers :test #'equal))) + (forge--ghub-delete topic + "/repos/:owner/:repo/pulls/:number/requested_reviewers" + `((reviewers . ,remove)) + :callback (forge--set-field-callback topic))))) + +(cl-defmethod forge--delete-comment + ((_repo forge-github-repository) post) + (forge--ghub-delete post "/repos/:owner/:repo/issues/comments/:number") + (closql-delete post) + (forge-refresh-buffer)) + +(cl-defmethod forge--topic-template-files ((repo forge-github-repository) + (_ (subclass forge-issue))) + (and-let* ((files (magit-revision-files (oref repo default-branch)))) + (let ((case-fold-search t)) + (if-let ((file (--first (string-match-p "\ +\\`\\(\\|docs/\\|\\.github/\\)issue_template\\(\\.[a-zA-Z0-9]+\\)?\\'" it) + files))) + (list file) + (setq files + (--filter (string-match-p "\\`\\.github/ISSUE_TEMPLATE/[^/]*" it) + files)) + (if-let ((conf (cl-find-if + (lambda (f) + (equal (file-name-nondirectory f) "config.yml")) + files))) + (nconc (delete conf files) + (list conf)) + files))))) + +(cl-defmethod forge--topic-template-files ((repo forge-github-repository) + (_ (subclass forge-pullreq))) + (and-let* ((files (magit-revision-files (oref repo default-branch)))) + (let ((case-fold-search t)) + (if-let ((file (--first (string-match-p "\ +\\`\\(\\|docs/\\|\\.github/\\)pull_request_template\\(\\.[a-zA-Z0-9]+\\)?\\'" it) + files))) + (list file) + ;; Unlike for issues, the web interface does not support + ;; multiple pull-request templates. The API does though, + ;; but due to this limitation I doubt many people use them, + ;; so Forge doesn't support them either. + )))) + +(cl-defmethod forge--set-default-branch ((repo forge-github-repository) + newname oldname) + (forge--ghub-post repo + (format "/repos/:owner/:name/branches/%s/rename" oldname) + `((new_name . ,newname))) + (message "Waiting 5 seconds for GitHub to complete rename...") + (sleep-for 5) + (message "Waiting 5 seconds for GitHub to complete rename...done") + (magit-call-git "fetch" "--prune" (oref repo remote)) + (magit--set-default-branch newname oldname)) + +(cl-defmethod forge--fork-repository ((repo forge-github-repository) fork) + (with-slots (owner name) repo + (forge--ghub-post repo + (format "/repos/%s/%s/forks" owner name) + (and (not (equal fork (ghub--username (ghub--host nil)))) + `((organization . ,fork)))) + (ghub-wait (format "/repos/%s/%s" fork name) nil :auth 'forge))) + +(cl-defmethod forge--merge-pullreq ((_repo forge-github-repository) + topic hash method) + (forge--ghub-put topic + "/repos/:owner/:repo/pulls/:number/merge" + `((merge_method . ,(symbol-name method)) + ,@(and hash `((sha . ,hash)))))) + +;;; Wrappers + +(cl-defun forge--ghub-get (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host + callback errorback) + (declare (indent defun)) + (ghub-get (if obj (forge--format-resource obj resource) resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback :errorback errorback)) + +(cl-defun forge--ghub-put (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host + callback errorback) + (declare (indent defun)) + (ghub-put (if obj (forge--format-resource obj resource) resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback :errorback errorback)) + +(cl-defun forge--ghub-post (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (ghub-post (forge--format-resource obj resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback :errorback errorback)) + +(cl-defun forge--ghub-patch (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (ghub-patch (forge--format-resource obj resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback :errorback errorback)) + +(cl-defun forge--ghub-delete (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (ghub-delete (forge--format-resource obj resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback :errorback errorback)) + +;;; _ +(provide 'forge-github) +;;; forge-github.el ends here diff --git a/elpa/forge-20240523.1103/forge-gitlab.el b/elpa/forge-20240523.1103/forge-gitlab.el new file mode 100644 index 00000000..55c4b454 --- /dev/null +++ b/elpa/forge-20240523.1103/forge-gitlab.el @@ -0,0 +1,684 @@ +;;; forge-gitlab.el --- Gitlab support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2024 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . + +;;; Code: + +(require 'glab) + +(require 'forge) +(require 'forge-issue) +(require 'forge-pullreq) + +;;; Class + +(defclass forge-gitlab-repository (forge-repository) + ((issues-url-format :initform "https://%h/%o/%n/issues") + (issue-url-format :initform "https://%h/%o/%n/issues/%i") + (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#note_%I") + (pullreqs-url-format :initform "https://%h/%o/%n/merge_requests") + (pullreq-url-format :initform "https://%h/%o/%n/merge_requests/%i") + (pullreq-post-url-format :initform "https://%h/%o/%n/merge_requests/%i#note_%I") + (commit-url-format :initform "https://%h/%o/%n/commit/%r") + (branch-url-format :initform "https://%h/%o/%n/commits/%r") + (remote-url-format :initform "https://%h/%o/%n") + (create-issue-url-format :initform "https://%h/%o/%n/issues/new") + (create-pullreq-url-format :initform "https://%h/%o/%n/merge_requests/new") + (pullreq-refspec :initform "+refs/merge-requests/*/head:refs/pullreqs/*"))) + +;;; Pull +;;;; Repository + +(cl-defmethod forge--pull ((repo forge-gitlab-repository) + &optional callback since) + (cl-assert (not (and since (forge-get-repository repo nil :tracked?)))) + (setq forge--mode-line-buffer (current-buffer)) + (forge--msg repo t nil "Pulling REPO") + (let ((cb (let ((buf (current-buffer)) + (val nil)) + (lambda (cb &optional v) + (when v (if val (push v val) (setq val v))) + (let-alist val + (cond + ((not val) + (forge--fetch-repository repo cb)) + ((not (assq 'assignees val)) + (forge--fetch-assignees repo cb)) + ((not (assq 'forks val)) + (forge--fetch-forks repo cb)) + ((not (assq 'labels val)) + (forge--fetch-labels repo cb)) + ((and .issues_enabled + (not (assq 'issues val))) + (forge--fetch-issues repo cb since)) + ((and .merge_requests_enabled + (not (assq 'pullreqs val))) + (forge--fetch-pullreqs repo cb since)) + (t + (forge--msg repo t t "Pulling REPO") + (forge--msg repo t nil "Storing REPO") + (closql-with-transaction (forge-db) + (forge--update-repository repo val) + (forge--update-assignees repo .assignees) + (forge--update-labels repo .labels) + (dolist (v .issues) (forge--update-issue repo v)) + (dolist (v .pullreqs) (forge--update-pullreq repo v)) + (oset repo condition :tracked)) + (forge--msg repo t t "Storing REPO") + (cond + ((oref repo selective-p)) + (callback (funcall callback)) + ((forge--maybe-git-fetch repo buf)))))))))) + (funcall cb cb))) + +(cl-defmethod forge--fetch-repository ((repo forge-gitlab-repository) callback) + (forge--glab-get repo "/projects/:project" nil + :callback (lambda (value _headers _status _req) + (cond ((oref repo selective-p) + (setq value (append '((assignees) (forks) (labels) + (issues) (pullreqs)) + value))) + ((magit-get-boolean "forge.omitExpensive") + (setq value (append '((assignees) (forks) (labels)) + value)))) + (funcall callback callback value)))) + +(cl-defmethod forge--update-repository ((repo forge-gitlab-repository) data) + (let-alist data + (oset repo created .created_at) + (oset repo updated .last_activity_at) + (oset repo pushed nil) + (oset repo parent .forked_from_project.path_with_namespace) + (oset repo description .description) + (oset repo homepage nil) + (oset repo default-branch .default_branch) + (oset repo archived-p .archived) + (oset repo fork-p (and .forked_from_project.path_with_namespace t)) + (oset repo locked-p nil) + (oset repo mirror-p .mirror) + (oset repo private-p (equal .visibility "private")) + (oset repo issues-p .issues_enabled) + (oset repo wiki-p .wiki_enabled) + (oset repo stars .star_count) + (oset repo watchers .star_count))) + +;;;; Topics + +(cl-defmethod forge--pull-topic ((repo forge-gitlab-repository) _topic + &key callback _errorback) + (forge--pull repo callback)) ; TODO Pull only the one topic. + +;;;; Issues + +(cl-defmethod forge--fetch-issues ((repo forge-gitlab-repository) callback since) + (let ((cb (let (val cur cnt pos) + (lambda (cb &optional v) + (cond + ((not pos) + (if (setq cur (setq val v)) + (progn + (setq pos 1) + (setq cnt (length val)) + (forge--msg nil nil nil "Pulling issue %s/%s" pos cnt) + (forge--fetch-issue-posts repo cur cb)) + (forge--msg repo t t "Pulling REPO issues") + (funcall callback callback (cons 'issues val)))) + (t + (if (setq cur (cdr cur)) + (progn + (cl-incf pos) + (forge--msg nil nil nil "Pulling issue %s/%s" pos cnt) + (forge--fetch-issue-posts repo cur cb)) + (forge--msg repo t t "Pulling REPO issues") + (funcall callback callback (cons 'issues val))))))))) + (forge--msg repo t nil "Pulling REPO issues") + (forge--glab-get repo "/projects/:project/issues" + `((per_page . 100) + (order_by . "updated_at") + ,@(and-let* ((after (or since (oref repo issues-until)))) + `((updated_after . ,after)))) + :unpaginate t + :callback (lambda (value _headers _status _req) + (funcall cb cb value))))) + +(cl-defmethod forge--fetch-issue-posts ((repo forge-gitlab-repository) cur cb) + (let-alist (car cur) + (forge--glab-get repo + (format "/projects/%s/issues/%s/notes" .project_id .iid) + '((per_page . 100)) + :unpaginate t + :callback (lambda (value _headers _status _req) + (setf (alist-get 'notes (car cur)) value) + (funcall cb cb))))) + +(cl-defmethod forge--update-issue ((repo forge-gitlab-repository) data) + (closql-with-transaction (forge-db) + (let-alist data + (let* ((issue-id (forge--object-id 'forge-issue repo .iid)) + (issue + (forge-issue + :id issue-id + :their-id .iid + :number .iid + :slug (format "#%s" .iid) + :repository (oref repo id) + ;; Gitlab doesn't make a distinction between completed + ;; and unplanned issues. Treat them all as completed. + :state (pcase-exhaustive .state + ("closed" 'completed) + ("opened" 'open)) + :author .author.username + :title .title + :created .created_at + :updated .updated_at + ;; `.closed_at' may be nil even though the issues is + ;; closed. In such cases use 1, so that this slot + ;; at least can serve as a boolean. + :closed (or .closed_at (and (equal .state "closed") 1)) + :locked-p .discussion_locked + :milestone .milestone.iid + :body (forge--sanitize-string .description)))) + (closql-insert (forge-db) issue t) + (unless (magit-get-boolean "forge.omitExpensive") + (forge--set-id-slot repo issue 'assignees .assignees) + (forge--set-id-slot repo issue 'labels .labels)) + (dolist (c .notes) + (let-alist c + (let ((post + (forge-issue-post + :id (forge--object-id issue-id .id) + :issue issue-id + :number .id + :author .author.username + :created .created_at + :updated .updated_at + :body (forge--sanitize-string .body)))) + (closql-insert (forge-db) post t)))) + (let ((until (oref repo issues-until))) + (when (or (not until) (string> .updated_at until)) + (oset repo issues-until .updated_at))) + issue)))) + +;;;; Pullreqs + +(cl-defmethod forge--fetch-pullreqs ((repo forge-gitlab-repository) callback since) + (let ((cb (let (val cur cnt pos) + (lambda (cb &optional v) + (cond + ((not pos) + (if (setq cur (setq val v)) + (progn + (setq pos 1) + (setq cnt (length val)) + (forge--msg nil nil nil "Pulling pullreq %s/%s" pos cnt) + (forge--fetch-pullreq-posts repo cur cb)) + (forge--msg repo t t "Pulling REPO pullreqs") + (funcall callback callback (cons 'pullreqs val)))) + ((not (assq 'source_project (car cur))) + (forge--fetch-pullreq-source-repo repo cur cb)) + ((not (assq 'target_project (car cur))) + (forge--fetch-pullreq-target-repo repo cur cb)) + (t + (if (setq cur (cdr cur)) + (progn + (cl-incf pos) + (forge--msg nil nil nil "Pulling pullreq %s/%s" pos cnt) + (forge--fetch-pullreq-posts repo cur cb)) + (forge--msg repo t t "Pulling REPO pullreqs") + (funcall callback callback (cons 'pullreqs val))))))))) + (forge--msg repo t nil "Pulling REPO pullreqs") + (forge--glab-get repo "/projects/:project/merge_requests" + `((per_page . 100) + (order_by . "updated_at") + ,@(and-let* ((after (or since (oref repo pullreqs-until)))) + `((updated_after . ,after)))) + :unpaginate t + :callback (lambda (value _headers _status _req) + (funcall cb cb value))))) + +(cl-defmethod forge--fetch-pullreq-posts + ((repo forge-gitlab-repository) cur cb) + (let-alist (car cur) + (forge--glab-get repo + (format "/projects/%s/merge_requests/%s/notes" .target_project_id .iid) + '((per_page . 100)) + :unpaginate t + :callback (lambda (value _headers _status _req) + (setf (alist-get 'notes (car cur)) value) + (funcall cb cb))))) + +(cl-defmethod forge--fetch-pullreq-source-repo + ((repo forge-gitlab-repository) cur cb) + ;; If the fork no longer exists, then `.source_project_id' is nil. + ;; This will lead to difficulties later on but there is nothing we + ;; can do about it. + (let-alist (car cur) + (if .source_project_id + (forge--glab-get repo (format "/projects/%s" .source_project_id) nil + :errorback (lambda (_err _headers _status _req) + (setf (alist-get 'source_project (car cur)) nil) + (funcall cb cb)) + :callback (lambda (value _headers _status _req) + (setf (alist-get 'source_project (car cur)) value) + (funcall cb cb))) + (setf (alist-get 'source_project (car cur)) nil) + (funcall cb cb)))) + +(cl-defmethod forge--fetch-pullreq-target-repo + ((repo forge-gitlab-repository) cur cb) + (let-alist (car cur) + (forge--glab-get repo (format "/projects/%s" .target_project_id) nil + :errorback (lambda (_err _headers _status _req) + (setf (alist-get 'target_project (car cur)) nil) + (funcall cb cb)) + :callback (lambda (value _headers _status _req) + (setf (alist-get 'target_project (car cur)) value) + (funcall cb cb))))) + +(cl-defmethod forge--update-pullreq ((repo forge-gitlab-repository) data) + (closql-with-transaction (forge-db) + (let-alist data + (let* ((pullreq-id (forge--object-id 'forge-pullreq repo .iid)) + (pullreq + (forge-pullreq + :id pullreq-id + :their-id .iid + :number .iid + :slug (format "!%s" .iid) + :repository (oref repo id) + :state (pcase-exhaustive .state + ("merged" 'merged) + ("closed" 'rejected) + ("opened" 'open)) + :author .author.username + :title .title + :created .created_at + :updated .updated_at + ;; `.merged_at' and `.closed_at' may both be nil even + ;; though the pullreq is merged or otherwise closed. + ;; In such cases use 1, so that these slots at least + ;; can serve as booleans. + :closed (or .closed_at + (and (member .state '("closed" "merged")) 1)) + :merged (or .merged_at + (and (equal .state "merged") 1)) + :draft-p .draft + :locked-p .discussion_locked + :editable-p .allow_maintainer_to_push + :cross-repo-p (not (equal .source_project_id + .target_project_id)) + :base-ref .target_branch + :base-rev .diff_refs.start_sha + :base-repo .target_project.path_with_namespace + :head-ref .source_branch + :head-rev .diff_refs.head_sha + :head-user .source_project.owner.username + :head-repo .source_project.path_with_namespace + :milestone .milestone.iid + :body (forge--sanitize-string .description)))) + (closql-insert (forge-db) pullreq t) + (unless (magit-get-boolean "forge.omitExpensive") + (forge--set-id-slot repo pullreq 'assignees .assignees) + (forge--set-id-slot repo pullreq 'review-requests .reviewers) + (forge--set-id-slot repo pullreq 'labels .labels)) + (dolist (c .notes) + (let-alist c + (let ((post + (forge-pullreq-post + :id (forge--object-id pullreq-id .id) + :pullreq pullreq-id + :number .id + :author .author.username + :created .created_at + :updated .updated_at + :body (forge--sanitize-string .body)))) + (closql-insert (forge-db) post t)))) + (let ((until (oref repo pullreqs-until))) + (when (or (not until) (string> .updated_at until)) + (oset repo pullreqs-until .updated_at))) + pullreq)))) + +;;;; Other + +;; The extend of the documentation for "GET /projects/:id/users" is +;; "Get the users list of a project." I don't know what that means, +;; but it stands to reason that this must at least overlap with the +;; set of users that can be assigned to topics. + +(cl-defmethod forge--fetch-assignees ((repo forge-gitlab-repository) callback) + (forge--glab-get repo "/projects/:project/users" + '((per_page . 100)) + :unpaginate t + :callback (lambda (value _headers _status _req) + (funcall callback callback (cons 'assignees value))))) + +(cl-defmethod forge--update-assignees ((repo forge-gitlab-repository) data) + (oset repo assignees + (with-slots (id) repo + (mapcar (lambda (row) + (let-alist row + ;; For other forges we don't need to store `id' + ;; but here we do because that's what has to be + ;; used when assigning issues. + (list (forge--object-id id .id) + .username + .name + .id))) + data)))) + +(cl-defmethod forge--fetch-forks ((repo forge-gitlab-repository) callback) + (forge--glab-get repo "/projects/:project/forks" + '((per_page . 100) + (simple . t)) + :unpaginate t + :callback (lambda (value _headers _status _req) + (funcall callback callback (cons 'forks value))))) + +(cl-defmethod forge--update-forks ((repo forge-gitlab-repository) data) + (oset repo forks + (with-slots (id) repo + (mapcar (lambda (row) + (let-alist row + (nconc (forge--repository-ids + (eieio-object-class repo) + (oref repo githost) + .namespace.path + .path) + (list .namespace.path + .path)))) + data)))) + +(cl-defmethod forge--fetch-labels ((repo forge-gitlab-repository) callback) + (forge--glab-get repo "/projects/:project/labels" + '((per_page . 100)) + :unpaginate t + :callback (lambda (value _headers _status _req) + (funcall callback callback (cons 'labels value))))) + +(cl-defmethod forge--update-labels ((repo forge-gitlab-repository) data) + (oset repo labels + (with-slots (id) repo + (mapcar (lambda (row) + (let-alist row + ;; We should use the label's `id' instead of its + ;; `name' but a topic's `labels' field is a list + ;; of names instead of a list of ids or an alist. + ;; As a result of this we cannot recognize when + ;; a label is renamed and a topic continues to be + ;; tagged with the old label name until it itself + ;; is modified somehow. Additionally it leads to + ;; name conflicts between group and project + ;; labels. See #160. + (list (forge--object-id id .name) + .name + (downcase .color) + .description))) + ;; For now simply remove one of the duplicates. + (cl-delete-duplicates data + :key (apply-partially #'alist-get 'name) + :test #'equal))))) + +;;;; Notifications + +;; The closest to notifications that Gitlab provides are "events" as +;; described at https://docs.gitlab.com/ee/api/events.html. This +;; allows us to see the last events that took place, but that is not +;; good enough because we are mostly interested in events we haven't +;; looked at yet. Gitlab doesn't make a distinction between unread +;; and read events, so this is rather useless and we don't use it for +;; the time being. + +;;; Mutations + +(cl-defmethod forge--submit-create-issue ((_ forge-gitlab-repository) repo) + (let-alist (forge--topic-parse-buffer) + (forge--glab-post repo "/projects/:project/issues" + `((title . , .title) + (description . , .body)) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback)))) + +(cl-defmethod forge--submit-create-pullreq ((_ forge-gitlab-repository) base-repo) + (let-alist (forge--topic-parse-buffer) + (pcase-let* ((`(,base-remote . ,base-branch) + (magit-split-branch-name forge--buffer-base-branch)) + (`(,head-remote . ,head-branch) + (magit-split-branch-name forge--buffer-head-branch)) + (head-repo (forge-get-repository :stub head-remote))) + (forge--glab-post head-repo "/projects/:project/merge_requests" + `((title . ,(if (if (local-variable-p 'forge-buffer-draft-p) + forge-buffer-draft-p + .draft) + (concat "Draft: " .title) + .title)) + (description . , .body) + ,@(and (not (equal head-remote base-remote)) + `((target_project_id . ,(oref base-repo forge-id)))) + (target_branch . ,base-branch) + (source_branch . ,head-branch) + (allow_collaboration . t)) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))))) + +(cl-defmethod forge--submit-create-post ((_ forge-gitlab-repository) topic) + (forge--glab-post topic + (if (forge-issue-p topic) + "/projects/:project/issues/:number/notes" + "/projects/:project/merge_requests/:number/notes") + `((body . ,(string-trim (buffer-string)))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))) + +(cl-defmethod forge--submit-edit-post ((_ forge-gitlab-repository) post) + (forge--glab-put post + (cl-etypecase post + (forge-pullreq "/projects/:project/merge_requests/:number") + (forge-issue "/projects/:project/issues/:number") + (forge-issue-post "/projects/:project/issues/:topic/notes/:number") + (forge-pullreq-post "/projects/:project/merge_requests/:topic/notes/:number")) + (if (cl-typep post 'forge-topic) + (let-alist (forge--topic-parse-buffer) + ;; Keep Gitlab from claiming that the user + ;; changed the description when that isn't + ;; true. The same isn't necessary for the + ;; title; in that case Gitlab performs the + ;; necessary check itself. + `((title . , .title) + ,@(and (not (equal .body (oref post body))) + `((description . , .body))))) + `((body . ,(string-trim (buffer-string))))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))) + +(cl-defmethod forge--set-topic-field + ((_repo forge-gitlab-repository) topic field value) + (forge--glab-put topic + (cl-typecase topic + (forge-pullreq "/projects/:project/merge_requests/:number") + (forge-issue "/projects/:project/issues/:number")) + `((,field . ,value)) + :callback (forge--set-field-callback topic))) + +(cl-defmethod forge--set-topic-title + ((repo forge-gitlab-repository) topic title) + (forge--set-topic-field repo topic 'title title)) + +(cl-defmethod forge--set-topic-state + ((repo forge-gitlab-repository) topic state) + (forge--set-topic-field repo topic 'state_event + (pcase-exhaustive state + ;; Merging isn't done through here. + ('completed "close") + ('unplanned "close") + ('rejected "close") + ('open "reopen")))) + +(cl-defmethod forge--set-topic-draft + ((repo forge-gitlab-repository) topic value) + (let ((buffer (current-buffer))) + (glab-graphql + `(mutation (mergeRequestSetDraft + [(input $input MergeRequestSetDraftInput!)] + (mergeRequest iid draft))) + `((input (projectPath . ,(format "%s/%s" + (oref repo owner) + (oref repo name))) + (iid . ,(number-to-string (oref topic number))) + (draft . ,value))) + :host (oref (forge-get-repository topic) apihost) + :auth 'forge + :callback (lambda (data &rest _) + (if (assq 'error data) + (ghub--graphql-pp-response data) + (oset topic draft-p value) + (forge-refresh-buffer buffer)))))) + +(cl-defmethod forge--set-topic-labels + ((repo forge-gitlab-repository) topic labels) + (forge--set-topic-field repo topic 'labels + (mapconcat #'identity labels ","))) + +(cl-defmethod forge--set-topic-assignees + ((repo forge-gitlab-repository) topic assignees) + (let ((users (mapcar #'cdr (oref repo assignees)))) + (cl-typecase topic + (forge-pullreq ; Can only be assigned to a single user. + (forge--set-topic-field repo topic 'assignee_id + (or (caddr (assoc (car assignees) users)) + 0))) + (forge-issue + (forge--set-topic-field repo topic 'assignee_ids + (or (--map (caddr (assoc it users)) assignees) + 0)))))) + +(cl-defmethod forge--set-topic-review-requests + ((repo forge-gitlab-repository) topic reviewers) + (let ((users (mapcar #'cdr (oref repo assignees)))) + (forge--set-topic-field repo topic 'reviewer_ids + (or (--map (caddr (assoc it users)) reviewers) + 0)))) + +(cl-defmethod forge--delete-comment + ((_repo forge-gitlab-repository) post) + (forge--glab-delete post + (cl-etypecase post + (forge-pullreq-post + "/projects/:project/merge_requests/:topic/notes/:number") + (forge-issue-post + "/projects/:project/issues/:topic/notes/:number"))) + (closql-delete post) + (forge-refresh-buffer)) + +(cl-defmethod forge--topic-template-files ((repo forge-gitlab-repository) + (_ (subclass forge-issue))) + (--filter (string-match-p "\\`\\.gitlab/issue_templates/.+\\.md\\'" it) + (magit-revision-files (oref repo default-branch)))) + +(cl-defmethod forge--topic-template-files ((repo forge-gitlab-repository) + (_ (subclass forge-pullreq))) + (--filter (string-match-p "\\`\\.gitlab/merge_request_templates/.+\\.md\\'" it) + (magit-revision-files (oref repo default-branch)))) + +(cl-defmethod forge--fork-repository ((repo forge-gitlab-repository) fork) + (with-slots (owner name) repo + (forge--glab-post repo (format "/projects/%s%%2F%s/fork" owner name) + (and (not (equal fork (ghub--username (ghub--host nil)))) + `((namespace . ,fork))) + :noerror t) + (ghub-wait (format "/projects/%s%%2F%s" fork name) + nil :auth 'forge :forge 'gitlab))) + +(cl-defmethod forge--merge-pullreq ((_repo forge-gitlab-repository) + topic hash method) + (forge--glab-put topic + "/projects/:project/merge_requests/:number/merge" + `((squash . ,(eq method 'squash)) + ,@(and hash `((sha . ,hash)))))) + +;;; Wrappers + +(cl-defun forge--glab-get (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (glab-get (if obj (forge--format-resource obj resource) resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback + :errorback (or errorback (and callback t)))) + +(cl-defun forge--glab-put (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (glab-put (if obj (forge--format-resource obj resource) resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback + :errorback (or errorback (and callback t)))) + +(cl-defun forge--glab-post (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (glab-post (forge--format-resource obj resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback + :errorback (or errorback (and callback t)))) + +(cl-defun forge--glab-delete (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (glab-delete (forge--format-resource obj resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback + :errorback (or errorback (and callback t)))) + +;;; _ +(provide 'forge-gitlab) +;;; forge-gitlab.el ends here diff --git a/elpa/forge-20240523.1103/forge-gogs.el b/elpa/forge-20240523.1103/forge-gogs.el new file mode 100644 index 00000000..6f2d372e --- /dev/null +++ b/elpa/forge-20240523.1103/forge-gogs.el @@ -0,0 +1,46 @@ +;;; forge-gogs.el --- Gogs support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2024 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . + +;;; Code: + +(require '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 diff --git a/elpa/forge-20240523.1103/forge-issue.el b/elpa/forge-20240523.1103/forge-issue.el new file mode 100644 index 00000000..614d7ca8 --- /dev/null +++ b/elpa/forge-20240523.1103/forge-issue.el @@ -0,0 +1,278 @@ +;;; forge-issue.el --- Issue support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2024 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . + +;;; Code: + +(require 'forge) +(require 'forge-post) +(require 'forge-topic) + +;;; Classes + +(defclass forge-issue (forge-topic) + ((closql-table :initform 'issue) + (closql-primary-key :initform 'id) + (closql-order-by :initform [(desc number)]) + (closql-foreign-key :initform 'repository) + (closql-class-prefix :initform "forge-") + (id :initarg :id) + (repository :initarg :repository) + (number :initarg :number) + (state :initarg :state) + (author :initarg :author) + (title :initarg :title) + (created :initarg :created) + (updated :initarg :updated :initform nil) + (closed :initarg :closed) + (status :initarg :status :initform nil) + (locked-p :initarg :locked-p) + (milestone :initarg :milestone) + (body :initarg :body) + (assignees :closql-table (issue-assignee assignee)) + (project-cards) ; projectsCards + (edits) ; userContentEdits + (labels :closql-table (issue-label label)) + (participants) + (posts :closql-class forge-issue-post) + (reactions) + (timeline) + (marks :closql-table (issue-mark mark)) + (note :initarg :note :initform nil) + (their-id :initarg :their-id) + (slug :initarg :slug) + (saved-p :initarg :saved-p :initform nil) + )) + +(defclass forge-issue-post (forge-post) + ((closql-table :initform 'issue-post) + (closql-primary-key :initform 'id) + (closql-order-by :initform [(asc number)]) + (closql-foreign-key :initform 'issue) + (closql-class-prefix :initform "forge-issue-") + (id :initarg :id) + (issue :initarg :issue) + (number :initarg :number) + (author :initarg :author) + (created :initarg :created) + (updated :initarg :updated) + (body :initarg :body) + (edits) + (reactions) + )) + +;;; Query +;;;; Get + +(cl-defmethod forge-get-repository ((post forge-issue-post)) + (forge-get-repository (forge-get-issue post))) + +(cl-defmethod forge-get-topic ((post forge-issue-post)) + (forge-get-issue post)) + +(cl-defmethod forge-get-issue ((issue forge-issue)) + issue) + +(cl-defmethod forge-get-issue ((repo forge-repository) number) + (closql-get (forge-db) + (forge--object-id 'forge-issue repo number) + 'forge-issue)) + +(cl-defmethod forge-get-issue ((number integer)) + (and-let* ((repo (forge-get-repository :tracked))) + (forge-get-issue repo number))) + +(cl-defmethod forge-get-issue ((id string)) + (closql-get (forge-db) id 'forge-issue)) + +(cl-defmethod forge-get-issue ((post forge-issue-post)) + (closql-get (forge-db) + (oref post issue) + 'forge-issue)) + +;;;; Current + +(defun forge-current-issue (&optional demand) + "Return the issue at point or being visited. +If there is no such issue and DEMAND is non-nil, then signal +an error." + (or (forge-issue-at-point) + (and (forge-issue-p forge-buffer-topic) + forge-buffer-topic) + (and demand (user-error "No current issue")))) + +(defun forge-issue-at-point (&optional demand) + "Return the issue at point. +If there is no such issue and DEMAND is non-nil, then signal +an error." + (or (thing-at-point 'forge-issue) + (magit-section-value-if 'issue) + (and (derived-mode-p 'forge-topic-list-mode) + (and-let* ((id (tabulated-list-get-id)) + (topic (forge-get-topic id))) + (and (forge-issue-p topic) + topic))) + (and demand (user-error "No issue at point")))) + +(put 'forge-issue 'thing-at-point #'forge-thingatpt--issue) +(defun forge-thingatpt--issue () + (and-let* ((repo (forge--repo-for-thingatpt))) + (and (thing-at-point-looking-at "#\\([0-9]+\\)\\_>") + (forge-get-issue repo (string-to-number (match-string 1)))))) + +;;;; List + +(defun forge--ls-recent-issues (repo) + (forge-ls-recent-topics repo 'issue)) + +(defun forge--ls-issues (repo) + (forge--select-issues repo + [:from issue :where (= issue:repository $s1)])) + +(defun forge--ls-open-issues (repo) + (forge--select-issues repo + [:from issue + :where (and (= issue:repository $s1) + (= issue:state 'open))])) + +(defun forge--ls-active-issues (repo) + (forge--select-issues repo + [:from issue + :where (and (= issue:repository $s1) + (or (= issue:state 'open) + (in issue:status [pending unread])))])) + +(defun forge--ls-assigned-issues (repo) + (forge--select-issues repo + [:from issue + :join issue_assignee :on (= issue_assignee:issue issue:id) + :join assignee :on (= issue_assignee:id assignee:id) + :where (and (= issue:repository $s1) + (= assignee:login $s2) + (isnull issue:closed))] + (ghub--username repo))) + +(defun forge--ls-authored-issues (repo) + (forge--select-issues repo + [:from [issue] + :where (and (= issue:repository $s1) + (= issue:author $s2) + (isnull issue:closed))] + (ghub--username repo))) + +(defun forge--ls-labeled-issues (repo label) + (forge--select-issues repo + [:from issue + :join issue_label :on (= issue_label:issue issue:id) + :join label :on (= issue_label:id label:id) + :where (and (= issue:repository $s1) + (= label:name $s2) + (isnull issue:closed))] + label)) + +(defun forge--ls-owned-issues () + (forge--select-issues nil + [:from [issue repository] + :where (and (= issue:repository repository:id) + (in repository:owner $v1) + (not (in repository:name $v2)) + (isnull issue:closed)) + :order-by [(asc repository:owner) + (asc repository:name) + (desc issue:number)]] + (vconcat (mapcar #'car forge-owned-accounts)) + (vconcat forge-owned-ignored))) + +(defun forge--select-issues (repo query &rest args) + (declare (indent 1)) + (mapcar (let ((db (forge-db))) + (lambda (row) + (closql--remake-instance 'forge-issue db row))) + (apply #'forge-sql + (vconcat [:select *] + query + (and (not (cl-find :order-by query)) + [:order-by [(desc updated)]])) + (if repo + (cons (oref repo id) args) + args)))) + +;;; Read + +(defun forge-read-issue (prompt) + "Read an active issue with completion using PROMPT. + +Open, unread and pending issues are considered active. +Default to the current issue even if it isn't active. + +\\While completion is in \ +progress, \\[forge-read-topic-lift-limit] lifts the limit, extending +the completion candidates to include all issues. + +If `forge-limit-topic-choices' is nil, then all candidates +can be selected from the start." + (forge--read-topic prompt + #'forge-current-issue + #'forge--ls-active-issues + #'forge--ls-issues)) + +(defun forge-read-open-issue (prompt) + "Read an open issue with completion using PROMPT." + (let* ((current (forge-current-issue)) + (repo (forge-get-repository (or current :tracked))) + (default (and current (forge--format-topic-line current))) + (alist (forge--topic-collection (forge--ls-open-issues repo))) + (choices (mapcar #'car alist)) + (choice (magit-completing-read prompt choices nil t nil nil default))) + (cdr (assoc choice alist)))) + +;;; Insert + +(defvar-keymap forge-issues-section-map + " " #'forge-browse-issues + " " #'forge-list-issues + "C-c C-m" #'forge-topics-menu + "C-c C-n" #'forge-create-issue) + +(defvar-keymap forge-issue-section-map + " " #'forge-visit-this-topic + "C-c C-m" #'forge-topic-menu) + +(defun forge-insert-issues () + "Insert a list of mostly recent and/or open issues. +Also see option `forge-topic-list-limit'." + (forge--insert-issues "Issues" #'forge--ls-recent-issues)) + +(defun forge-insert-assigned-issues () + "Insert a list of open issues that are assigned to you." + (forge--insert-issues "Assigned issues" #'forge--ls-assigned-issues)) + +(defun forge-insert-authored-issues () + "Insert a list of open issues that are authored by you." + (forge--insert-issues "Authored issues" #'forge--ls-authored-issues)) + +(defun forge--insert-issues (heading getter) + (when-let ((repo (forge--assert-insert-topics-get-repository t))) + (forge--insert-topics 'issues heading (funcall getter repo)))) + +;;; _ +(provide 'forge-issue) +;;; forge-issue.el ends here diff --git a/elpa/forge-20240523.1103/forge-notify.el b/elpa/forge-20240523.1103/forge-notify.el new file mode 100644 index 00000000..4415cdf5 --- /dev/null +++ b/elpa/forge-20240523.1103/forge-notify.el @@ -0,0 +1,327 @@ +;;; forge-notify.el --- Notify support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2024 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . + +;;; Code: + +(require 'forge) +(require 'forge-topic) + +;;; Options + +(defcustom forge-notifications-repo-slug-width 28 + "Width of repository slugs in `forge-notifications-mode' buffers." + :package-version '(forge . "0.4.0") + :group 'forge + :type (if (>= emacs-major-version 28) 'natnum 'number)) + +;;; Class + +(defclass forge-notification (forge-object) + ((closql-class-prefix :initform "forge-") + (closql-table :initform 'notification) + (closql-primary-key :initform 'id) + (closql-order-by :initform [(desc id)]) + (id :initarg :id) + (thread-id :initarg :thread-id) + (repository :initarg :repository) + (type :initarg :type) + (topic :initarg :topic) + (url :initarg :url) + (title :initarg :title) + (reason :initarg :reason) + (last-read :initarg :last-read) + (updated :initarg :updated))) + +;;; Query +;;;; Get + +(cl-defmethod forge-get-repository ((notify forge-notification)) + "Return the object for the repository that NOTIFY belongs to." + (and-let* ((id (oref notify repository))) + (closql-get (forge-db) id 'forge-repository))) + +(cl-defmethod forge-get-topic ((notify forge-notification)) + (and-let* ((repo (forge-get-repository notify))) + (forge-get-topic repo (oref notify topic)))) + +(cl-defmethod forge-get-notification ((id string)) + (closql-get (forge-db) id 'forge-notification)) + +(cl-defmethod forge-get-notification ((topic forge-topic)) + (and-let* ((row (car (forge-sql [:select * :from notification + :where (and (= repository $s1) + (= topic $s2))] + (oref topic repository) + (oref topic number))))) + (closql--remake-instance 'forge-notification (forge-db) row))) + +;;;; Current + +(defun forge-current-notification (&optional demand) + "Return the current notification, casting a topic if necessary. +If there is no such notification and DEMAND is non-nil, then +signal an error." + (or (magit-section-value-if 'notification) + (and-let* ((topic (forge-current-topic))) + (forge-get-notification topic)) + (and demand (user-error "No current notification")))) + +(defun forge-notification-at-point (&optional demand) + "Return the notification at point, casting a topic if necessary. +If there is no such notification and DEMAND is non-nil, then +signal an error." + (or (magit-section-value-if 'notification) + (and-let* ((topic (forge-topic-at-point))) + (forge-get-notification topic)) + (and demand (user-error "No notification at point")))) + +;;;; List + +(defun forge--ls-notifications (status) + (let* ((status (ensure-list status)) + (savedp (memq 'saved status)) + (status (remq 'saved status))) + (mapcar + (lambda (row) (closql--remake-instance 'forge-notification (forge-db) row)) + (if (seq-set-equal-p status '(unread pending done) #'eq) + (forge-sql [:select * :from notification :order-by [(desc updated)]]) + (forge-sql + `[:select :distinct notification:* + :from [notification (as issue topic)] + :where (and (= notification:topic topic:id) + ,@(and status '((in topic:status $v1))) + ,@(and savedp '((= topic:saved-p 't)))) + :union + :select :distinct notification:* + :from [notification (as pullreq topic)] + :where (and (= notification:topic topic:id) + ,@(and status '((in topic:status $v1))) + ,@(and savedp '((= topic:saved-p 't)))) + :order-by [(desc notification:updated)]] + (vconcat status)))))) + +;;; Mode + +(defvar-keymap forge-notifications-mode-map + :doc "Keymap for `forge-notifications-mode'." + :parent magit-mode-map + " " #'magit-refresh-buffer + "C-c C-m" #'forge-notifications-menu) + +(define-derived-mode forge-notifications-mode magit-mode "Forge Notifications" + "Mode for looking at forge notifications." + (hack-dir-local-variables-non-file-buffer)) + +(defun forge-notifications-setup-buffer () + (magit-setup-buffer-internal #'forge-notifications-mode nil + '((default-directory "/") + (forge-buffer-unassociated-p t)) + (get-buffer-create "*forge-notifications*"))) + +(defun forge-notifications-refresh-buffer () + (forge-insert-notifications)) + +(defvar forge-notifications-display-style 'flat) +(defvar forge-notifications-selection '(unread pending)) + +;;; Commands + +(transient-define-prefix forge-notifications-menu () + "Control list of notifications and notification at point." + :transient-suffix t + :transient-non-suffix t + :transient-switch-frame nil + :refresh-suffixes t + :column-widths forge--topic-menus-column-widths + [:hide always + ("q" forge-menu-quit-list) + ("RET" forge-topic-menu) + ("" forge-topic-menu)] + [["Type" + ("t" "topics..." forge-topics-menu :transient replace) + (:info "notifications" :face forge-suffix-active) + ("r" "repositories..." forge-repositories-menu :transient replace) + ""] + ["Selection" + ("I" forge-notifications-display-inbox) + ("S" forge-notifications-display-saved) + ("D" forge-notifications-display-done) + ("A" forge-notifications-display-all)]] + [forge--topic-set-state-group + ["Group" + ("f" forge-notifications-style-flat) + ("g" forge-notifications-style-nested)]] + [forge--topic-set-status-group] + (interactive) + (unless (derived-mode-p 'forge-notifications-mode) + (forge-list-notifications)) + (transient-setup 'forge-notifications-menu)) + +;;;###autoload +(defun forge-list-notifications () + "List notifications." + (interactive) + (forge-notifications-setup-buffer)) + +(transient-define-suffix forge-notifications-display-inbox () + "List unread and pending notifications." + :description "inbox" + :inapt-if (lambda () (equal forge-notifications-selection '(unread pending))) + :inapt-face 'forge-suffix-active + (interactive) + (unless (derived-mode-p 'forge-notifications-mode) + (user-error "Not in notification buffer")) + (setq forge-notifications-selection '(unread pending)) + (forge-refresh-buffer)) + +(transient-define-suffix forge-notifications-display-saved () + "List saved notifications." + :description "saved" + :inapt-if (lambda () (eq forge-notifications-selection 'saved)) + :inapt-face 'forge-suffix-active + (interactive) + (unless (derived-mode-p 'forge-notifications-mode) + (user-error "Not in notification buffer")) + (setq forge-notifications-selection 'saved) + (forge-refresh-buffer)) + +(transient-define-suffix forge-notifications-display-done () + "List done notifications." + :description "done" + :inapt-if (lambda () (eq forge-notifications-selection 'done)) + :inapt-face 'forge-suffix-active + (interactive) + (unless (derived-mode-p 'forge-notifications-mode) + (user-error "Not in notification buffer")) + (setq forge-notifications-selection 'done) + (forge-refresh-buffer)) + +(transient-define-suffix forge-notifications-display-all () + "List all notifications." + :description "all" + :inapt-if (lambda () (equal forge-notifications-selection '(unread pending done))) + :inapt-face 'forge-suffix-active + (interactive) + (unless (derived-mode-p 'forge-notifications-mode) + (user-error "Not in notification buffer")) + (setq forge-notifications-selection '(unread pending done)) + (forge-refresh-buffer)) + +(transient-define-suffix forge-notifications-style-flat () + "Show a flat notification list." + :description "flat list" + :inapt-if (lambda () (eq forge-notifications-display-style 'flat)) + :inapt-face 'forge-suffix-active + (interactive) + (unless (derived-mode-p 'forge-notifications-mode) + (user-error "Not in notification buffer")) + (setq forge-notifications-display-style 'flat) + (forge-refresh-buffer)) + +(transient-define-suffix forge-notifications-style-nested () + "Group notifications by repository." + :description "by repository" + :inapt-if (lambda () (eq forge-notifications-display-style 'nested)) + :inapt-face 'forge-suffix-active + (interactive) + (unless (derived-mode-p 'forge-notifications-mode) + (user-error "Not in notification buffer")) + (setq forge-notifications-display-style 'nested) + (forge-refresh-buffer)) + +;;; Sections + +(defclass forge-repository-section (magit-section) + ((type :initform 'forge-repo) + (keymap :initform 'forge-repository-section-map))) + +(define-obsolete-variable-alias 'forge-forge-repo-section-map + 'forge-repository-section-map "Forge 0.4.0") + +(defvar-keymap forge-repository-section-map + " " #'forge-browse-this-repository + " " #'forge-visit-this-repository) + +(defun forge-insert-notifications () + (let* ((status forge-notifications-selection) + (notifs (forge--ls-notifications status))) + (magit-insert-section (notifications) + (magit-insert-heading + (cond + ((not (listp status)) + (format "%s notifications" (capitalize (symbol-name status)))) + ((seq-set-equal-p status '(unread pending)) "Inbox") + ((seq-set-equal-p status '(unread pending done)) "All notifications") + ((format "Notifications %s" status)))) + (if (eq forge-notifications-display-style 'flat) + (magit-insert-section-body + (if (not notifs) + (insert "(empty)\n") + (dolist (notif notifs) + (forge-insert-notification notif)) + (insert ?\n))) + (pcase-dolist (`(,_ . ,notifs) + (--group-by (oref it repository) notifs)) + (let ((repo (forge-get-repository (car notifs)))) + (magit-insert-section (forge-repo repo) + (magit-insert-heading + (concat (propertize (format "%s/%s" + (oref repo owner) + (oref repo name)) + 'font-lock-face 'bold) + (format " (%s)" (length notifs)))) + (magit-insert-section-body + (dolist (notif notifs) + (forge-insert-notification notif)) + (insert ?\n))))))))) + +(defun forge-insert-notification (notif) + (with-slots (type title url) notif + (pcase type + ((or 'issue 'pullreq) + (forge--insert-topic (forge-get-topic notif))) + ('commit + (magit-insert-section (ncommit nil) ; !commit + (string-match "[^/]*\\'" url) + (insert + (format "%s %s\n" + (propertize (substring (match-string 0 url) + 0 (magit-abbrev-length)) + 'font-lock-face 'magit-hash) + (magit-log-propertize-keywords + nil + (propertize title 'font-lock-face + (if-let ((topic (oref notif topic)) + ((eq (oref topic status) 'unread))) + 'forge-topic-unread + 'forge-topic-open))))))) + (_ + ;; The documentation does not mention what "types" + ;; exist. Make it obvious that this is something + ;; we do not know how to handle properly yet. + (magit-insert-section (notification notif) + (insert (propertize (format "(%s) %s\n" type title) + 'font-lock-face 'error))))))) + +;;; _ +(provide 'forge-notify) +;;; forge-notify.el ends here diff --git a/elpa/forge-20240523.1103/forge-pkg.el b/elpa/forge-20240523.1103/forge-pkg.el new file mode 100644 index 00000000..b12d4495 --- /dev/null +++ b/elpa/forge-20240523.1103/forge-pkg.el @@ -0,0 +1,23 @@ +(define-package "forge" "20240523.1103" "Access Git forges from Magit." + '((emacs "26.3") + (compat "29.1.4.5") + (closql "20240405") + (dash "2.19.1") + (emacsql "20240124") + (ghub "20240507") + (let-alist "1.0.6") + (magit "20240428") + (markdown-mode "2.6") + (seq "2.24") + (transient "20240421") + (yaml "0.5.5")) + :commit "ceb6f5b8d257fe5e79532793cdd055c3dddd8806" :authors + '(("Jonas Bernoulli" . "emacs.forge@jonas.bernoulli.dev")) + :maintainer + '("Jonas Bernoulli" . "emacs.forge@jonas.bernoulli.dev") + :keywords + '("git" "tools" "vc") + :url "https://github.com/magit/forge") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/forge-20240523.1103/forge-post.el b/elpa/forge-20240523.1103/forge-post.el new file mode 100644 index 00000000..084a9b7b --- /dev/null +++ b/elpa/forge-20240523.1103/forge-post.el @@ -0,0 +1,255 @@ +;;; forge-post.el --- Post support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2024 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . + +;;; Code: + +(require 'markdown-mode) + +(require 'forge) + +;;; Options + +(defcustom forge-post-mode-hook + '(visual-line-mode + turn-on-flyspell) + "Hook run after entering Forge-Post mode." + :package-version '(forge . "0.2.0") + :group 'forge + :type 'hook + :options '(visual-line-mode + turn-on-flyspell)) + +(defcustom forge-buffer-draft-p nil + "Whether new pull-requests start out as drafts by default. + +The buffer-local value is use to keep track of the draft status +of the current pull-request." + :package-version '(forge . "0.4.0") + :group 'forge + :type 'boolean) + +;;; Class + +(defclass forge-post (forge-object) () :abstract t) + +;;; Query +;;;; Get + +(cl-defmethod forge-get-parent ((post forge-post)) + (forge-get-topic post)) + +(cl-defmethod forge-get-repository ((post forge-post)) + (forge-get-repository (forge-get-topic post))) + +;;;; Current + +(defun forge-post-at-point (&optional assert) + "Return the post at point. +If there is no such post and DEMAND is non-nil, then signal +an error." + (or (magit-section-value-if '(issue pullreq post)) + (and assert (user-error "There is no post at point")))) + +(defun forge-comment-at-point (&optional assert) + "Return the comment at point. +If there is no such comment and DEMAND is non-nil, then signal +an error." + (or (and (magit-section-value-if '(post)) + (let ((post (oref (magit-current-section) value))) + (and (or (forge-pullreq-post-p post) + (forge-issue-post-p post)) + post))) + (and assert (user-error "There is no comment at point")))) + +;;; Utilities + +(cl-defmethod forge--format ((post forge-post) slot &optional spec) + (forge--format (forge-get-topic post) slot + `(,@spec (?I . ,(oref post number))))) + +;;; Mode + +(defvar-keymap forge-post-mode-map + "C-c C-e" #'forge-post-dispatch + "C-c C-c" #'forge-post-submit + " " #'forge-post-submit + " " #'forge-post-submit + "C-c C-k" #'forge-post-cancel + " " #'forge-post-cancel + " " #'forge-post-cancel + " " #'forge-post-cancel + " " #'forge-post-cancel) + +(define-derived-mode forge-post-mode gfm-mode "Forge-Post" "") + +(defvar-local forge--buffer-base-branch nil) +(defvar-local forge--buffer-head-branch nil) +(defvar-local forge--buffer-post-object nil) +(defvar-local forge--buffer-issue nil) +(defvar-local forge--submit-post-function nil) +(defvar-local forge--cancel-post-function nil) +(defvar-local forge--pre-post-buffer nil) +(make-variable-buffer-local 'forge-buffer-draft-p) + +(defun forge--prepare-post-buffer (filename &optional header source target) + (let ((file (convert-standard-filename + (expand-file-name (concat "magit/posts/" filename) + (magit-gitdir))))) + (make-directory (file-name-directory file) t) + (let ((prevbuf (current-buffer)) + (resume (and (file-exists-p file) + (> (file-attribute-size (file-attributes file)) 0))) + (buf (find-file-noselect file))) + (with-current-buffer buf + (forge-post-mode) + (when header + (magit-set-header-line-format header)) + (setq forge--pre-post-buffer prevbuf) + (when resume + (forge--display-post-buffer buf) + (when (magit-read-char-case "A draft already exists. " nil + (?r "[r]esume editing existing draft") + (?d "[d]iscard draft and start over" t)) + (erase-buffer) + (setq resume nil))) + (when (and (not resume) (string-prefix-p "new" filename)) + (let-alist (forge--topic-template + (forge-get-repository :tracked) + (if source 'forge-pullreq 'forge-issue)) + (cond + (.url + (browse-url .url) + (forge-post-cancel) + (setq buf nil) + (message "Using browser to visit %s instead of opening an issue" + .url)) + (.name + ;; A Github issue with yaml frontmatter. + (save-excursion (insert .text)) + (unless (re-search-forward "^title: " nil t) + (when (re-search-forward "^---" nil t 2) + (beginning-of-line) + (insert "title: \n") + (backward-char)))) + (t + (insert "# ") + (let ((single + (and source + (= (car (magit-rev-diff-count source target)) 1)))) + (save-excursion + (when single + ;; A pull-request. + (magit-rev-insert-format "%B" source)) + (when .text + (if single + (insert "-------\n") + (insert "\n")) + (insert "\n" .text))))))))) + buf))) + +(defun forge--display-post-buffer (buf) + (magit-display-buffer buf #'display-buffer)) + +(defun forge-post-cancel () + "Cancel the post that is being edited in the current buffer." + (interactive) + (save-buffer) + (if-let ((fn forge--cancel-post-function)) + (funcall fn forge--buffer-post-object) + (magit-mode-bury-buffer 'kill))) + +(defun forge-post-submit () + "Submit the post that is being edited in the current buffer." + (interactive) + (save-buffer) + (if-let ((fn forge--submit-post-function)) + (funcall fn + (forge-get-repository forge--buffer-post-object) + forge--buffer-post-object) + (error "forge--submit-post-function is nil"))) + +(defun forge--post-submit-callback () + (let* ((file buffer-file-name) + (editbuf (current-buffer)) + (prevbuf forge--pre-post-buffer) + (topic (ignore-errors (forge-get-topic forge--buffer-post-object))) + (repo (forge-get-repository topic))) + (lambda (value headers status req) + (run-hook-with-args 'forge-post-submit-callback-hook + value headers status req) + (delete-file file t) + (let ((dir (file-name-directory file))) + (unless (cddr (directory-files dir nil nil t)) + (delete-directory dir nil t))) + (when (buffer-live-p editbuf) + (with-current-buffer editbuf + (magit-mode-bury-buffer 'kill))) + (with-current-buffer + (if (buffer-live-p prevbuf) prevbuf (current-buffer)) + (if (and topic + (forge--childp repo 'forge-github-repository) + (oref repo selective-p)) + (forge--pull-topic repo topic) + (forge-pull)))))) + +(defun forge--post-submit-errorback () + (lambda (error &rest _) + (error "Failed to submit post: %S" error))) + +(transient-define-prefix forge-post-dispatch () + "Dispatch a post creation command." + ["Variables" + ("d" "Create draft" forge-post-toggle-draft)] + ["Act" + ("C-c" "Submit" forge-post-submit) + ("C-k" "Cancel" forge-post-cancel)]) + +(transient-define-infix forge-post-toggle-draft () + "Toggle whether the pull-request being created is a draft." + :class 'transient-lisp-variable + :variable 'forge-buffer-draft-p + :reader (lambda (&rest _) (not forge-buffer-draft-p)) + :if (lambda () (equal (file-name-nondirectory buffer-file-name) "new-pullreq"))) + +;;; Notes + +(defclass forge-note (forge-post) ()) + +(defvar-keymap forge-note-section-map + " " #'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 diff --git a/elpa/forge-20240523.1103/forge-pullreq.el b/elpa/forge-20240523.1103/forge-pullreq.el new file mode 100644 index 00000000..6ff5c4be --- /dev/null +++ b/elpa/forge-20240523.1103/forge-pullreq.el @@ -0,0 +1,358 @@ +;;; forge-pullreq.el --- Pullreq support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2024 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . + +;;; Code: + +(require 'forge) +(require 'forge-post) +(require 'forge-topic) + +;;; Classes + +(defclass forge-pullreq (forge-topic) + ((closql-table :initform 'pullreq) + (closql-primary-key :initform 'id) + (closql-order-by :initform [(desc number)]) + (closql-foreign-key :initform 'repository) + (closql-class-prefix :initform "forge-") + (id :initarg :id) + (repository :initarg :repository) + (number :initarg :number) + (state :initarg :state) + (author :initarg :author) + (title :initarg :title) + (created :initarg :created) + (updated :initarg :updated :initform nil) + (closed :initarg :closed) + (merged :initarg :merged) + (status :initarg :status :initform nil) + (locked-p :initarg :locked-p) + (editable-p :initarg :editable-p) + (cross-repo-p :initarg :cross-repo-p) + (base-ref :initarg :base-ref) + (base-repo :initarg :base-repo) + (head-ref :initarg :head-ref) + (head-user :initarg :head-user) + (head-repo :initarg :head-repo) + (milestone :initarg :milestone) + (body :initarg :body) + (assignees :closql-table (pullreq-assignee assignee)) + (project-cards) ; projectsCards + (commits) + (edits) ; userContentEdits + (labels :closql-table (pullreq-label label)) + (participants) + (posts :closql-class forge-pullreq-post) + (reactions) + (review-requests :closql-table (pullreq-review-request assignee)) + (reviews) + (timeline) + (marks :closql-table (pullreq-mark mark)) + (note :initarg :note :initform nil) + (base-rev :initarg :base-rev) + (head-rev :initarg :head-rev) + (draft-p :initarg :draft-p) + (their-id :initarg :their-id) + (slug :initarg :slug) + (saved-p :initarg :saved-p :initform nil) + )) + +(defclass forge-pullreq-post (forge-post) + ((closql-table :initform 'pullreq-post) + (closql-primary-key :initform 'id) + (closql-order-by :initform [(asc number)]) + (closql-foreign-key :initform 'pullreq) + (closql-class-prefix :initform "forge-pullreq-") + (id :initarg :id) + (pullreq :initarg :pullreq) + (number :initarg :number) + (author :initarg :author) + (created :initarg :created) + (updated :initarg :updated) + (body :initarg :body) + (edits) + (reactions) + )) + +;;; Query +;;;; Get + +(cl-defmethod forge-get-repository ((post forge-pullreq-post)) + (forge-get-repository (forge-get-pullreq post))) + +(cl-defmethod forge-get-topic ((post forge-pullreq-post)) + (forge-get-pullreq post)) + +(cl-defmethod forge-get-pullreq ((pullreq forge-pullreq)) + pullreq) + +(cl-defmethod forge-get-pullreq ((repo forge-repository) number) + (closql-get (forge-db) + (forge--object-id 'forge-pullreq repo number) + 'forge-pullreq)) + +(cl-defmethod forge-get-pullreq ((number integer)) + (and-let* ((repo (forge-get-repository :tracked))) + (forge-get-pullreq repo number))) + +(cl-defmethod forge-get-pullreq ((id string)) + (closql-get (forge-db) id 'forge-pullreq)) + +(cl-defmethod forge-get-pullreq ((post forge-pullreq-post)) + (closql-get (forge-db) + (oref post pullreq) + 'forge-pullreq)) + +(cl-defmethod forge-get-pullreq ((_(eql :branch)) &optional branch) + (and-let* ((branch (or branch + (magit-section-case + (branch (oref it value)) + (commit (magit--painted-branch-at-point))))) + (branch (cdr (magit-split-branch-name branch))) + (number (magit-get "branch" branch "pullRequest"))) + (forge-get-pullreq (string-to-number number)))) + +;;;; Current + +(defun forge-current-pullreq (&optional demand) + "Return the pull-request at point or being visited. +If there is no such pull-request and DEMAND is non-nil, then signal +an error." + (or (forge-pullreq-at-point) + (and (forge-pullreq-p forge-buffer-topic) + forge-buffer-topic) + (and demand (user-error "No current pull-request")))) + +(defun forge-pullreq-at-point (&optional demand) + "Return the pull-request at point. +If there is no such pull-request and DEMAND is non-nil, then signal +an error." + (or (thing-at-point 'forge-pullreq) + (magit-section-value-if 'pullreq) + (forge-get-pullreq :branch) + (and (derived-mode-p 'forge-topic-list-mode) + (and-let* ((id (tabulated-list-get-id)) + (topic (forge-get-topic id))) + (and (forge-pullreq-p topic) + topic))) + (and demand (user-error "No pull-request at point")))) + +(put 'forge-pullreq 'thing-at-point #'forge-thingatpt--pullreq) +(defun forge-thingatpt--pullreq () + (and-let* ((repo (forge--repo-for-thingatpt))) + (and (thing-at-point-looking-at + (if (forge-gitlab-repository--eieio-childp repo) + "[#!]\\([0-9]+\\)\\_>" + "#\\([0-9]+\\)\\_>")) + (forge-get-pullreq repo (string-to-number (match-string 1)))))) + +;;;; List + +(defun forge--ls-recent-pullreqs (repo) + (forge-ls-recent-topics repo 'pullreq)) + +(defun forge--ls-pullreqs (repo) + (forge--select-pullreqs repo + [:from pullreq :where (= pullreq:repository $s1)])) + +(defun forge--ls-active-pullreqs (repo) + (forge--select-pullreqs repo + [:from pullreq + :where (and (= pullreq:repository $s1) + (or (= pullreq:state 'open) + (in pullreq:status [pending unread])))])) + +(defun forge--ls-assigned-pullreqs (repo) + (forge--select-pullreqs repo + [:from pullreq + :join pullreq_assignee :on (= pullreq_assignee:pullreq pullreq:id) + :join assignee :on (= pullreq_assignee:id assignee:id) + :where (and (= pullreq:repository $s1) + (= assignee:login $s2) + (isnull pullreq:closed))] + (ghub--username repo))) + +(defun forge--ls-requested-reviews (repo) + (forge--select-pullreqs repo + [:from pullreq + :join pullreq_review_request :on (= pullreq_review_request:pullreq pullreq:id) + :join assignee :on (= pullreq_review_request:id assignee:id) + :where (and (= pullreq:repository $s1) + (= assignee:login $s2) + (isnull pullreq:closed))] + (ghub--username repo))) + +(defun forge--ls-authored-pullreqs (repo) + (forge--select-pullreqs repo + [:from [pullreq] + :where (and (= pullreq:repository $s1) + (= pullreq:author $s2) + (isnull pullreq:closed))] + (ghub--username repo))) + +(defun forge--ls-labeled-pullreqs (repo label) + (forge--select-pullreqs repo + [:from pullreq + :join pullreq_label :on (= pullreq_label:pullreq pullreq:id) + :join label :on (= pullreq_label:id label:id) + :where (and (= pullreq:repository $s1) + (= label:name $s2) + (isnull pullreq:closed))] + label)) + +(defun forge--ls-owned-pullreqs () + (forge--select-pullreqs nil + [:from [pullreq repository] + :where (and (= pullreq:repository repository:id) + (in repository:owner $v1) + (not (in repository:name $v2)) + (isnull pullreq:closed)) + :order-by [(asc repository:owner) + (asc repository:name) + (desc pullreq:number)]] + (vconcat (mapcar #'car forge-owned-accounts)) + (vconcat forge-owned-ignored))) + +(defun forge--select-pullreqs (repo query &rest args) + (declare (indent 1)) + (mapcar (let ((db (forge-db))) + (lambda (row) + (closql--remake-instance 'forge-pullreq db row))) + (apply #'forge-sql + (vconcat [:select *] + query + (and (not (cl-find :order-by query)) + [:order-by [(desc updated)]])) + (if repo + (cons (oref repo id) args) + args)))) + +;;; Read + +(defun forge-read-pullreq (prompt) + "Read an active pull-request with completion using PROMPT. + +Open, unread and pending pull-requests are considered active. +Default to the current pull-request even if it isn't active. + +\\While completion is in \ +progress, \\[forge-read-topic-lift-limit] lifts the limit, extending +the completion candidates to include all pull-requests. + +If `forge-limit-topic-choices' is nil, then all candidates +can be selected from the start." + (forge--read-topic prompt + #'forge-current-pullreq + #'forge--ls-active-pullreqs + #'forge--ls-pullreqs)) + +;;; Utilities + +(defun forge--pullreq-branch-internal (pullreq) + (let ((branch (oref pullreq head-ref))) + ;; It is invalid for a branch name to begin with a colon, yet + ;; that is what Gitlab uses when a pull-request's source branch + ;; has been deleted. On Github this is simply nil in the same + ;; situation. + (and branch (not (string-prefix-p ":" branch)) branch))) + +(defun forge--pullreq-branch-active (pullreq) + (let* ((number (number-to-string (oref pullreq number))) + (branch-n (format "pr-%s" number)) + (branch (forge--pullreq-branch-internal pullreq))) + (or (and (magit-branch-p branch) + (equal (magit-get "branch" branch "pullRequest") number) + branch) + (and (magit-branch-p branch-n) + (equal (magit-get "branch" branch-n "pullRequest") number) + branch-n)))) + +(defun forge--pullreq-ref (pullreq) + (let ((ref (format "refs/pullreqs/%s" (oref pullreq number)))) + (and (magit-rev-verify ref) ref))) + +(defun forge--pullreq-range (pullreq &optional endpoints) + (and-let* ((head (forge--pullreq-ref pullreq))) + (concat (forge--get-remote) "/" (oref pullreq base-ref) + (if endpoints "..." "..") + head))) + +;;; Insert + +(defvar-keymap forge-pullreqs-section-map + " " #'forge-browse-pullreqs + " " #'forge-list-pullreqs + "C-c C-m" #'forge-topics-menu + "C-c C-n" #'forge-create-pullreq) + +(defvar-keymap forge-pullreq-section-map + " " #'forge-visit-this-topic + "C-c C-m" #'forge-topic-menu) + +(defun forge-insert-pullreqs () + "Insert a list of mostly recent and/or open pull-requests. +Also see option `forge-topic-list-limit'." + (forge--insert-pullreqs "Pull requests" + #'forge--ls-recent-pullreqs)) + +(defun forge-insert-assigned-pullreqs () + "Insert a list of open pull-requests that are assigned to you." + (forge--insert-pullreqs "Assigned pull requests" + #'forge--ls-assigned-pullreqs)) + +(defun forge-insert-requested-reviews () + "Insert a list of pull-requests that are awaiting your review." + (forge--insert-pullreqs "Pull requests awaiting review" + #'forge--ls-requested-reviews)) + +(defun forge-insert-authored-pullreqs () + "Insert a list of open pullreqs that are authored by you." + (forge--insert-pullreqs "Authored pullreqs" + #'forge--ls-authored-pullreqs)) + +(defun forge--insert-pullreqs (heading getter) + (when-let ((repo (forge--assert-insert-topics-get-repository))) + (forge--insert-topics 'pullreqs heading (funcall getter repo)))) + +(defun forge--insert-pullreq-commits (pullreq &optional all) + (cl-letf (((symbol-function #'magit-cancel-section) (lambda ()))) + (if all + ;; Numeric pr ref, pr branch (if it exists) and api + ;; pr range may be out of sync. Just show them all. + (magit-insert-section-body + (magit--insert-log nil + (delq nil (list (concat "^" (or (oref pullreq base-rev) + (concat (forge--get-remote) "/" + (oref pullreq base-ref)))) + (forge--pullreq-ref pullreq) + (forge--pullreq-branch-active pullreq) + (and-let* ((branch (oref pullreq head-ref))) + (and (magit-local-branch-p branch) branch)))) + (seq-uniq (cons "--graph" magit-buffer-log-args)))) + (when-let ((range (forge--pullreq-range pullreq))) + (magit-insert-section-body + (magit--insert-log nil range magit-buffer-log-args) + (magit-make-margin-overlay nil t)))))) + +;;; _ +(provide 'forge-pullreq) +;;; forge-pullreq.el ends here diff --git a/elpa/forge-20240523.1103/forge-repo.el b/elpa/forge-20240523.1103/forge-repo.el new file mode 100644 index 00000000..998831a0 --- /dev/null +++ b/elpa/forge-20240523.1103/forge-repo.el @@ -0,0 +1,531 @@ +;;; forge-repo.el --- Repository support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2024 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . + +;;; Code: + +(require 'forge) +(require 'eieio) + +;;; Classes + +(defclass forge-repository (forge-object) + ((closql-class-prefix :initform "forge-") + (closql-class-suffix :initform "-repository") + (closql-table :initform 'repository) + (closql-primary-key :initform 'id) + (issues-url-format :initform nil :allocation :class) + (issue-url-format :initform nil :allocation :class) + (issue-post-url-format :initform nil :allocation :class) + (pullreqs-url-format :initform nil :allocation :class) + (pullreq-url-format :initform nil :allocation :class) + (pullreq-post-url-format :initform nil :allocation :class) + (commit-url-format :initform nil :allocation :class) + (branch-url-format :initform nil :allocation :class) + (remote-url-format :initform nil :allocation :class) + (create-issue-url-format :initform nil :allocation :class) + (create-pullreq-url-format :initform nil :allocation :class) + (pullreq-refspec :initform nil :allocation :class) + (id :initform nil :initarg :id) + (forge-id :initform nil :initarg :forge-id) + (forge :initform nil :initarg :forge) + (owner :initform nil :initarg :owner) + (name :initform nil :initarg :name) + (apihost :initform nil :initarg :apihost) + (githost :initform nil :initarg :githost) + (remote :initform nil :initarg :remote) + (condition :initform :stub) + (created :initform nil) + (updated :initform nil) + (pushed :initform nil) + (parent :initform nil) + (description :initform nil) + (homepage :initform nil) + (default-branch :initform nil) + (archived-p :initform nil) + (fork-p :initform nil) + (locked-p :initform nil) + (mirror-p :initform nil) + (private-p :initform nil) + (issues-p :initform t) + (wiki-p :initform nil) + (stars :initform nil) + (watchers :initform nil) + (assignees :closql-table assignee) + (forks :closql-table fork) + (issues :closql-class forge-issue) + (labels :closql-table label) + (pullreqs :closql-class forge-pullreq) + (revnotes :closql-class forge-revnote) + (selective-p :initform nil) + (worktree :initform nil) + (milestones :closql-table milestone) + (issues-until :initform nil) + (pullreqs-until :initform nil)) + :abstract t) + +(defclass forge-unusedapi-repository (forge-repository) () :abstract t) + +(defclass forge-noapi-repository (forge-repository) () :abstract t) + +(cl-defmethod slot-missing ((object forge-repository) + slot-name operation &optional _new-value) + (if (and (eq operation 'oref) + (eq slot-name 'slug)) + (concat (oref object owner) "/" + (oref object name)) + (cl-call-next-method))) + +;;; Query +;;;; Get + +(defvar-local forge-buffer-repository nil) +(put 'forge-buffer-repository 'permanent-local t) + +(defvar-local forge-buffer-unassociated-p nil) + +(defconst forge--signal-no-entry '(:tracked :stub :insert!)) + +(defun forge--get-remote (&optional warn) + (let* ((remotes (magit-list-remotes)) + (config (magit-get "forge.remote")) + (remote (if (cdr remotes) + (or (car (member config remotes)) + (car (member "upstream" remotes)) + (car (member "origin" remotes))) + (car remotes)))) + (when (and warn config remote (not (equal config remote))) + (message "Ignored forge.remote=%s; no such remote.\nSee %s." config + "https://magit.vc/manual/forge/Repository-Detection.html")) + remote)) + +(cl-defmethod forge-get-repository ((_(eql :id)) id) + (closql-get (forge-db) (substring-no-properties id) 'forge-repository)) + +(cl-defmethod forge-get-repository ((demand symbol) &optional remote) + "Return the current forge repository. + +First check if `forge-buffer-repository', or if that is nil, then +the repository for `forge-buffer-topic', satisfies DEMAND. If so, +then return that repository. + +Otherwise return the repository for `default-directory', if that +exists and satisfies DEMAND. If that fails too, then return nil +or signal an error, depending on DEMAND." + (or (and-let* ((repo (or (forge-buffer-repository) + (and forge-buffer-topic + (forge-get-repository forge-buffer-topic))))) + (forge-get-repository repo 'noerror demand)) + (magit--with-refresh-cache + (list default-directory 'forge-get-repository demand) + (if (not (magit-gitdir)) + (when (memq demand forge--signal-no-entry) + (error + "Cannot determine Forge repository outside of Git repository")) + (unless remote + (setq remote (forge--get-remote 'warn))) + (if-let ((url (and remote + (magit-git-string "remote" "get-url" remote)))) + (and-let* ((repo (forge-get-repository url remote demand))) + (progn ; work around debbugs#31840 + (oset repo worktree (magit-toplevel)) + repo)) + (when (memq demand forge--signal-no-entry) + (error + "Cannot determine forge repository. %s\nSee %s." + (cond (remote (format "No url configured for %S." remote)) + ((and-let* ((config (magit-get "forge.remote"))) + (format "Value of `forge.remote' is %S but %s" + config "that remote does not exist."))) + ((magit-list-remotes) "Cannot decide on remote to use.") + (t "No remote configured.")) + "https://magit.vc/manual/forge/Repository-Detection.html"))))))) + +(cl-defmethod forge-get-repository ((url string) &optional remote demand) + "Return the repository at URL." + (if-let ((parts (forge--split-forge-url url))) + (forge-get-repository parts remote (or demand :known?)) + (when (memq demand forge--signal-no-entry) + (error "Cannot determine forge repository. %s isn't a forge URL. %s" + url "You might have to customize `forge-alist'.")))) + +(cl-defmethod forge-get-repository (((host owner name) list) + &optional remote demand) + "((HOST OWNER NAME) &optional REMOTE DEMAND) + +Return the repository identified by HOST, OWNER and NAME. +See `forge-alist' for valid Git hosts." + (setq host (substring-no-properties host)) + (setq owner (substring-no-properties owner)) + (setq name (substring-no-properties name)) + (unless (memq demand '( :tracked :tracked? + :known? :insert! :valid? + :stub :stub?)) + (if-let ((new (pcase demand + ('t :tracked) + ('full :tracked?) + ('nil :known?) + ('create :insert!) + ('stub :stub) + ('maybe :stub?)))) + (progn + (message "Obsolete value for `%s's DEMAND: `%s'; use `%s' instead" + 'forge-get-repository demand new) + (setq demand new)) + (error "Unknown value for `%s's DEMAND: `%s'" + 'forge-get-repository demand))) + (if-let ((spec (forge--get-forge-host host t))) + (pcase-let ((`(,githost ,apihost ,webhost ,class) spec)) + ;; The `webhost' is used to identify the corresponding forge. + ;; For that reason it is stored in the `forge' slot. The id + ;; stored in the `id' slot also derives from that value. + (let* ((row (car (forge-sql [:select * :from repository + :where (and (= forge $s1) + (= owner $s2) + (= name $s3))] + webhost owner name))) + (obj (and row (closql--remake-instance class (forge-db) row)))) + ;; Synchronize the object with the entry from `forge-alist'. + ;; This only has an effect if the entry was modified, which + ;; should rarely, if ever, happen. Avoid confusion, by not + ;; mentioning this detail in any docstring. + (when obj + (oset obj apihost apihost) + (oset obj githost githost) + (oset obj remote remote)) + (pcase (list demand (and obj (eq (oref obj condition) :tracked))) + (`(:tracked? nil) (setq obj nil)) + (`(:tracked nil) + (error "Cannot use `%s' in %S yet.\n%s" + this-command (magit-toplevel) + "Use `M-x forge-add-repository' before trying again."))) + (when (and (memq demand '(:insert! :valid? :stub :stub?)) + (not obj)) + (pcase-let ((`(,id . ,forge-id) + (forge--repository-ids + class webhost owner name + (memq demand '(:stub :stub?)) + (eq demand :valid?)))) + (if (not id) + ;; `:valid?' was used and it turned out it is not. + (setq obj nil) + ;; The repo might have been renamed on the forge. #188 + (unless (setq obj (forge-get-repository :id id)) + (setq obj (funcall class + :id id + :forge-id forge-id + :forge webhost + :owner owner + :name name + :apihost apihost + :githost githost + :remote remote)) + (when (eq demand :insert!) + (closql-insert (forge-db) obj) + (oset obj condition :known)))))) + obj)) + (when (memq demand forge--signal-no-entry) + (error "Cannot determine forge repository. No entry for %S in %s" + host 'forge-alist)))) + +(cl-defmethod forge-get-repository ((repo forge-repository) + &optional noerror demand) + (setq noerror (and noerror t)) + (with-slots (condition slug) repo + (cl-symbol-macrolet + ((err (error "Requested %s for %s, but is %s" demand slug condition)) + (key (list (oref repo forge) + (oref repo owner) + (oref repo name))) + (ins (forge-get-repository key nil :insert!)) + (set (forge-get-repository key nil :valid?))) + (pcase-exhaustive (list demand condition noerror) + (`(nil ,_ ,_) repo) + (`(:tracked? :tracked ,_) repo) + (`(:tracked? ,_ ,_) nil) + (`(:tracked :tracked ,_) repo) + (`(:tracked ,_ t) nil) + (`(:tracked ,_ nil) err) + (`(:known? ,(or :tracked :known) ,_) repo) + (`(:known? ,_ ,_) nil) + (`(:insert! ,(or :tracked :known) ,_) repo) + (`(:insert! ,_ ,_) ins) + (`(:valid? ,(or :tracked :known) ,_) repo) + (`(:valid? ,_ ,_) set) + (`(:stub? ,_ ,_) repo) + (`(:stub ,_ ,_) repo))))) + +(cl-defmethod forge-get-repository ((_ null) &optional noerror demand) + (if (and (memq demand '(:insert! :tracked :stub)) + (not noerror)) + (error "(Maybe repository) is nil; `%s' not satisfied" demand) + nil)) + +(defun forge--get-repository:tracked? () + (forge-get-repository :tracked?)) + +(defun forge-get-worktree (repo) + "Validate and return the worktree recorded for REPO. +If no worktree is recorded, return nil. If a worktree is recorded but +that doesn't exist anymore, then discard the recorded value and return +nil." + (and-let* ((worktree (oref repo worktree))) + (if (file-directory-p worktree) + worktree + (oset repo worktree nil) + nil))) + +;;;; Current + +(defun forge-current-repository (&optional demand) + "Return the repository at point or being visited. +If there is no such repository and DEMAND is non-nil, then signal +an error." + (or (forge-repository-at-point) + (forge-buffer-repository) + (forge-get-repository :known?) + (and demand (user-error "No current repository")))) + +(defun forge-repository-at-point (&optional demand) + "Return the repository at point. +If there is no such repository and DEMAND is non-nil, then signal +an error." + (or (magit-section-value-if 'forge-repo) + (and-let* ((topic (forge-topic-at-point))) + (forge-get-repository topic)) + (and (derived-mode-p 'forge-repository-list-mode) + (and-let* ((id (tabulated-list-get-id))) + (forge-get-repository :id id))) + (and demand (user-error "No repository at point")))) + +(defun forge--repo-for-thingatpt () + (or (magit-section-value-if 'forge-repo) + (and-let* ((topic (magit-section-value-if '(issue pullreq)))) + (forge-get-repository topic)) + (and (not forge-buffer-unassociated-p) + (or (forge-buffer-repository) + (forge-get-repository :known?))))) + +(defun forge-buffer-repository () + (and-let* ((id forge-buffer-repository)) + (forge-get-repository :id id))) + +;;;; List + +(defun forge--ls-repos () + (mapcar (let ((db (forge-db))) + (lambda (row) + (closql--remake-instance 'forge-repository db row))) + (forge-sql [:select * :from repository + :order-by [(asc owner) (asc name)]]))) + +(defun forge--ls-owned-repos () + (mapcar (let ((db (forge-db))) + (lambda (row) + (closql--remake-instance 'forge-repository db row))) + (forge-sql [:select * :from repository + :where (and (in owner $v1) + (not (in name $v2))) + :order-by [(asc owner) (asc name)]] + (vconcat (mapcar #'car forge-owned-accounts)) + (vconcat forge-owned-ignored)))) + +;;; Identity + +(defun forge-repository-equal (repo1 repo2) + "Return t if REPO1 and REPO2 are the same repository. +REPO1 and/or REPO2 may also be nil, in which case return nil." + (and repo1 repo2 + (or (equal (oref repo1 id) (oref repo2 id)) + (and (equal (oref repo1 githost) (oref repo2 githost)) + (equal (oref repo1 owner) (oref repo2 owner)) + (equal (oref repo1 name) (oref repo2 name)))))) + +(cl-defmethod forge--repository-ids ((class (subclass forge-repository)) + host owner name &optional stub noerror) + "Return (OUR-ID . THEIR-ID) of the specified repository. +If optional STUB is non-nil, then the IDs are not guaranteed to +be unique. Otherwise this method has to make an API request to +retrieve THEIR-ID, the repository's ID on the forge. In that +case OUR-ID derives from THEIR-ID and is unique across all +forges and hosts." + (pcase-let* ((`(,_githost ,apihost ,id ,_class) + (forge--get-forge-host host t)) + (path (format "%s/%s" owner name)) + (their-id (and (not stub) + (ghub-repository-id + owner name + :host apihost + :auth 'forge + :forge (forge--ghub-type-symbol class) + :noerror noerror)))) + (and (or stub their-id (not noerror)) + (cons (base64-encode-string + (format "%s:%s" id + (cond (stub path) + ((eq class 'forge-github-repository) + ;; This is base64 encoded, according to + ;; https://docs.github.com/en/graphql/ + ;; reference/scalars#id. Unfortunately + ;; that is not always true. E.g., + ;; https://github.com/dit7ya/roamex. + (condition-case nil + (base64-decode-string their-id) + (error their-id))) + (t their-id))) + t) + (or their-id path))))) + +(cl-defmethod forge--repository-ids ((_class (subclass forge-noapi-repository)) + host owner name &optional _stub _noerror) + (let ((their-id (if owner (concat owner "/" name) name))) + (cons (base64-encode-string + (format "%s:%s" + (nth 3 (forge--get-forge-host host t)) + their-id) + t) + their-id))) + +;;; Read + +(defun forge-read-repository (prompt) + (let ((choice (magit-completing-read + prompt + (mapcar (pcase-lambda (`(,host ,owner ,name)) + (format "%s/%s @%s" owner name host)) + (forge-sql [:select [githost owner name] + :from repository])) + nil t nil nil + (and-let* ((default (forge-current-repository))) + (format "%s/%s @%s" + (oref default owner) + (oref default name) + (oref default githost)))))) + (save-match-data + (if (string-match "\\`\\(.+\\)/\\([^/]+\\) @\\(.+\\)\\'" choice) + (forge-get-repository (list (match-string 3 choice) + (match-string 1 choice) + (match-string 2 choice))) + (error "BUG"))))) + +(defun forge-read-host (prompt &optional class) + (magit-completing-read + prompt + (if class + (seq-keep (pcase-lambda (`(,githost ,_apihost ,_webhost ,c)) + (and (child-of-class-p c class) githost)) + forge-alist) + (mapcar #'car forge-alist)) + nil t)) + +;;; Miscellaneous + +(defun forge--as-githost (host) + (or (car (car (cl-member host forge-alist :test #'equal :key #'car))) + (car (car (cl-member host forge-alist :test #'equal :key #'cadr))) + (car (car (cl-member host forge-alist :test #'equal :key #'caddr))) + (user-error "Cannot determine githost for %S" host))) + +(defun forge--as-apihost (host) + (or (cadr (car (cl-member host forge-alist :test #'equal :key #'cadr))) + (cadr (car (cl-member host forge-alist :test #'equal :key #'car))) + (cadr (car (cl-member host forge-alist :test #'equal :key #'caddr))) + (user-error "Cannot determine apihost for %S" host))) + +(cl-defmethod forge--format ((repo forge-repository) format-or-slot &optional spec) + (pcase-let* (((eieio (forge webhost) owner name) repo) + (path (if owner (concat owner "/" name) name))) + (format-spec + (let ((format (if (symbolp format-or-slot) + (eieio-oref repo format-or-slot) + format-or-slot))) + (if (member webhost ghub-insecure-hosts) + (replace-regexp-in-string "\\`https://" "http://" format t t) + format)) + `(,@spec + (?h . ,webhost) + (?o . ,owner) + (?n . ,name) + (?p . ,path) + (?P . ,(string-replace "/" "%2F" path)))))) + +(defun forge--set-field-callback (topic) + (lambda (&rest _) + (forge--pull-topic + (forge-get-repository topic) + topic + :callback (lambda () + (forge-refresh-buffer) + (when (and transient--showp + (memq transient-current-command + '(forge-topic-menu + forge-topics-menu + forge-notifications-menu))) + (transient--refresh-transient)))))) + +(defvar forge--mode-line-buffer nil) + +(defun forge--msg (repo echo done format &rest args) + (let ((msg (apply #'format format args))) + (when repo + (setq msg (string-replace + "REPO" + (concat (oref repo owner) "/" (oref repo name)) + msg))) + (when (and echo msg) + (message "%s%s" msg (if done "...done" "..."))) + (when (buffer-live-p forge--mode-line-buffer) + (with-current-buffer forge--mode-line-buffer + (setq mode-line-process + (if done + nil + (concat " " (propertize msg 'font-lock-face + 'magit-mode-line-process))))) + (force-mode-line-update t)))) + +(cl-defmethod ghub--host ((repo forge-repository)) + (cl-call-next-method (forge--ghub-type-symbol (eieio-object-class repo)))) + +(cl-defmethod ghub--username ((repo forge-repository)) + (let ((default-directory default-directory)) + (unless (forge-repository-equal (forge-get-repository :stub?) repo) + (when-let ((worktree (forge-get-worktree repo))) + (setq default-directory worktree))) + (cl-call-next-method (oref repo apihost) + (forge--ghub-type-symbol (eieio-object-class repo))))) + +(defun forge--ghub-type-symbol (class) + (pcase-exhaustive class + ;; This package does not define a `forge-gitlab-http-repository' + ;; class, but we used to suggest at #9 that users define such a class + ;; if they must connect to a Gitlab instance that uses http instead + ;; of https. Doing that isn't necessary anymore, but we have to keep + ;; supporting it here. It is now sufficient to add an entry to + ;; `ghub-insecure-hosts'. + ((or 'forge-gitlab-repository 'forge-gitlab-http-repository) 'gitlab) + ('forge-github-repository 'github) + ('forge-gitea-repository 'gitea) + ('forge-gogs-repository 'gogs) + ('forge-bitbucket-repository 'bitbucket))) + +;;; _ +(provide 'forge-repo) +;;; forge-repo.el ends here diff --git a/elpa/forge-20240523.1103/forge-repos.el b/elpa/forge-20240523.1103/forge-repos.el new file mode 100644 index 00000000..93a6b6b5 --- /dev/null +++ b/elpa/forge-20240523.1103/forge-repos.el @@ -0,0 +1,193 @@ +;;; forge-repos.el --- List repositories -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2024 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . + +;;; Code: + +(require 'hl-line) + +(require 'forge-repo) +(require 'forge-tablist) + +(defvar x-stretch-cursor) + +;;; Options + +(defcustom forge-repository-list-mode-hook '(hl-line-mode) + "Hook run after entering Forge-Repository-List mode." + :package-version '(forge . "0.4.0") + :group 'forge + :type 'hook + :options '(hl-line-mode)) + +(defcustom forge-repository-list-columns + '(("Owner" owner 20 t nil) + ("Name" name 20 t nil) + ("T" forge-format-repo-condition 1 t nil) + ("S" forge-format-repo-selective 1 t nil) + ("Worktree" worktree 99 t nil)) + "List of columns displayed when listing repositories. + +Each element has the form (HEADER SOURCE WIDTH SORT PROPS). + +HEADER is the string displayed in the header. WIDTH is the width +of the column. SOURCE is used to get the value, it has to be the +name of a slot of `forge-repository' or a function that takes +such an object as argument. SORT is a boolean or a function used +to sort by this column. Supported PROPS include `:right-align' +and `:pad-right'." + :package-version '(forge . "0.4.0") + :group 'forge + :type forge--tablist-columns-type) + +;;; Mode + +(defvar-keymap forge-repository-list-mode-map + :doc "Local keymap for Forge-Repository-List mode buffers." + :parent tabulated-list-mode-map + "RET" #'forge-visit-this-repository + "" #'forge-visit-this-repository + "o" #'forge-browse-this-repository + "C-c C-m" #'forge-repositories-menu + "'" #'forge-dispatch + "?" #'magit-dispatch) + +(defvar forge-repository-list-buffer-name "*forge-repositories*" + "Buffer name to use for displaying lists of repositories.") + +(defvar forge-repository-list-mode-name + '((:eval (capitalize + (concat (if forge--buffer-list-filter + (format "%s " forge--buffer-list-filter) + "") + "repositories")))) + "Information shown in the mode-line for `forge-repository-list-mode'. +Must be set before `forge-list' is loaded.") + +(define-derived-mode forge-repository-list-mode tabulated-list-mode + forge-repository-list-mode-name + "Major mode for browsing a list of repositories." + (setq-local x-stretch-cursor nil) + (setq tabulated-list-padding 0) + (setq tabulated-list-sort-key (cons "Owner" nil))) + +(defun forge-repository-list-setup (filter fn) + (let ((buffer (get-buffer-create forge-repository-list-buffer-name))) + (with-current-buffer buffer + (setq default-directory "/") + (setq forge--tabulated-list-columns forge-repository-list-columns) + (setq forge--tabulated-list-query fn) + (cl-letf (((symbol-function #'tabulated-list-revert) #'ignore)) ; see #229 + (forge-repository-list-mode)) + (setq forge--buffer-list-type 'repo) + (setq forge--buffer-list-filter filter) + (setq forge--buffer-list-global t) + (forge--tablist-refresh) + (add-hook 'tabulated-list-revert-hook #'forge--tablist-refresh nil t) + (tabulated-list-print) + (when hl-line-mode + (hl-line-highlight))) + (switch-to-buffer buffer))) + +(defun forge-format-repo-condition (repo) + "Return a character representing the value of REPO's `condition' slot." + (pcase-exhaustive (oref repo condition) + (:tracked "*") + (:known " ") + (:stub (propertize "s" 'face 'warning)))) + +(defun forge-format-repo-selective (repo) + "Return a character representing the value of REPO's `selective-p' slot." + (pcase-exhaustive (oref repo selective-p) + ('t "*") + ('nil " "))) + +;;; Menu + +;;;###autoload (autoload 'forge-repositories-menu "forge-repos" nil t) +(transient-define-prefix forge-repositories-menu () + "Control list of repositories and repository at point." + :transient-suffix t + :transient-non-suffix 'call + :transient-switch-frame nil + :refresh-suffixes t + [:hide always ("q" forge-menu-quit-list)] + [["Type" + ("t" "topics..." forge-topics-menu :transient replace) + ("n" "notifications..." forge-notifications-menu :transient replace) + ("r" "repositories" forge-list-repositories)] + ["Filter" + ("o" "owned" forge-list-owned-repositories)]] + (interactive) + (unless (derived-mode-p 'forge-repository-list-mode) + (if-let ((buffer (get-buffer forge-repository-list-buffer-name))) + (switch-to-buffer buffer) + (with-no-warnings ; "interactive use only" + (forge-list-repositories)))) + (transient-setup 'forge-repositories-menu)) + +;;; Class + +(defclass forge--repo-list-command (transient-suffix) + ((type :initarg :type :initform nil) + (filter :initarg :filter :initform nil) + (global :initarg :global :initform nil) + (inapt-if :initform 'forge--topic-list-inapt) + (inapt-face :initform nil))) + +(defun forge--topic-list-inapt () + (with-slots (type filter global) transient--pending-suffix + (and (eq type forge--buffer-list-type) + (eq filter forge--buffer-list-filter) + (eq global forge--buffer-list-global)))) + +(cl-defmethod transient-format-description ((obj forge--repo-list-command)) + (with-slots (description type filter global) obj + (if (and (eq type forge--buffer-list-type) + (memq filter (list nil forge--buffer-list-filter)) + (eq global forge--buffer-list-global)) + (propertize description 'face 'forge-active-suffix) + description))) + +;;; Commands + +;;;###autoload (autoload 'forge-list-repositories "forge-repos" nil t) +(transient-define-suffix forge-list-repositories () + "List known repositories in a separate buffer. +Here \"known\" means that an entry exists in the local database." + :class 'forge--repo-list-command :type 'repo :global t + (interactive) + (forge-repository-list-setup nil #'forge--ls-repos)) + +;;;###autoload (autoload 'forge-list-owned-repositories "forge-repos" nil t) +(transient-define-suffix forge-list-owned-repositories () + "List your own known repositories in a separate buffer. +Here \"known\" means that an entry exists in the local database +and options `forge-owned-accounts' and `forge-owned-ignored' +controls which repositories are considered to be owned by you. +Only Github is supported for now." + :class 'forge--repo-list-command :type 'repo :filter 'owned :global t + (interactive) + (forge-repository-list-setup 'owned #'forge--ls-owned-repos)) + +;;; _ +(provide 'forge-repos) +;;; forge-repos.el ends here diff --git a/elpa/forge-20240523.1103/forge-revnote.el b/elpa/forge-20240523.1103/forge-revnote.el new file mode 100644 index 00000000..da550632 --- /dev/null +++ b/elpa/forge-20240523.1103/forge-revnote.el @@ -0,0 +1,47 @@ +;;; forge-revnote.el --- Revnote support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2024 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . + +;;; Code: + +(require 'forge) +(require 'forge-post) +(require 'forge-topic) + +;;; 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 diff --git a/elpa/forge-20240523.1103/forge-semi.el b/elpa/forge-20240523.1103/forge-semi.el new file mode 100644 index 00000000..a7f68068 --- /dev/null +++ b/elpa/forge-20240523.1103/forge-semi.el @@ -0,0 +1,83 @@ +;;; forge-semi.el --- Support for semi-forges -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2024 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . + +;;; Code: + +(require 'forge) + +;;; 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 diff --git a/elpa/forge-20240523.1103/forge-tablist.el b/elpa/forge-20240523.1103/forge-tablist.el new file mode 100644 index 00000000..31e2561e --- /dev/null +++ b/elpa/forge-20240523.1103/forge-tablist.el @@ -0,0 +1,85 @@ +;;; forge-tablist.el --- Tabulated-list interface -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2024 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . + +;;; Code: + +(require 'tabulated-list) + +(require 'forge) + +(defvar-local forge--buffer-list-type nil) +(defvar-local forge--buffer-list-filter nil) +(defvar-local forge--buffer-list-global nil) + +(defconst forge--tablist-columns-type + '(repeat + (list :tag "Column" + (string :tag "Header Label") + (choice :tag "Value source" + function + (symbol :tag "Object slot")) + (integer :tag "Column Width") + (choice :tag "Sort predicate" + (const :tag "Don't sort" nil) + (const :tag "Default" t) + function) + (plist :tag "Properties" + :key-type (choice :tag "Property" + (const :right-align) + (const :pad-right) + symbol) + :value-type (sexp :tag "Value"))))) + +(defvar-local forge--tabulated-list-columns nil) +(put 'forge--tabulated-list-columns 'permanent-local t) + +(defvar-local forge--tabulated-list-query nil) +(put 'forge--tabulated-list-query 'permanent-local t) + +(defun forge--tablist-refresh () + (setq tabulated-list-format + (vconcat (mapcar (pcase-lambda (`(,name ,_get ,width ,sort ,props)) + `(,name ,width ,sort . ,props)) + forge--tabulated-list-columns))) + (tabulated-list-init-header) + (setq tabulated-list-entries + (mapcar + (lambda (obj) + (list (oref obj id) + (vconcat + (mapcar (pcase-lambda (`(,_name ,get ,_width ,_sort ,_props)) + (let ((val (cond + ((functionp get) + (funcall get obj)) + ((eq (car-safe get) 'repository) + (eieio-oref (forge-get-repository obj) + (cadr get))) + ((eieio-oref obj get))))) + (cond ((stringp val) val) + ((null val) "") + ((format "%s" val))))) + forge--tabulated-list-columns)))) + (funcall forge--tabulated-list-query)))) + +;;; _ +(provide 'forge-tablist) +;;; forge-tablist.el ends here diff --git a/elpa/forge-20240523.1103/forge-topic.el b/elpa/forge-20240523.1103/forge-topic.el new file mode 100644 index 00000000..df2f0c38 --- /dev/null +++ b/elpa/forge-20240523.1103/forge-topic.el @@ -0,0 +1,1566 @@ +;;; forge-topic.el --- Topics support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2024 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . + +;;; Code: + +(require 'bug-reference) +(require 'markdown-mode) +(require 'parse-time) +(require 'yaml) + +(require 'forge) +(require 'forge-post) + +(defvar bug-reference-auto-setup-functions) + +;;; Options + +(defcustom forge-topic-list-order '(updated . string>) + "Order of topics listed in the status buffer. + +The value has the form (SLOT . PREDICATE), where SLOT is a +slot of issue or pullreq objects, and PREDICATE is a function +used to order the topics by that slot. Reasonable values +include (number . >) and (updated . string>)." + :package-version '(forge . "0.1.0") + :group 'forge + :type '(cons (symbol :tag "Slot") + (function :tag "Predicate"))) + +(defcustom forge-topic-list-limit '(60 . 5) + "Limit the number of topics listed in the status buffer. + +All unread topics are always shown. If the value of this option +has the form (OPEN . CLOSED), then the integer OPEN specifies the +maximal number of topics and CLOSED specifies the maximal number +of closed topics. IF CLOSED is negative then show no closed +topics until the command `forge-toggle-closed-visibility' changes +the sign. + +The value can also be an integer, in which case it limits the +number of closed topics only." + :package-version '(forge . "0.1.0") + :group 'forge + :type '(choice (number :tag "Maximal number of closed topics") + (cons (number :tag "Maximal number of open topics") + (number :tag "Maximal number of closed topics")))) + +(defcustom forge-limit-topic-choices t + "Whether to initially limit completion candidates to active topics." + :package-version '(forge . "0.4.0") + :group 'forge + :type 'boolean) + +(defcustom forge-post-heading-format "%a %C\n" + "Format for post headings in topic view. + +The following %-sequences are supported: + +`%a' The forge nickname of the author. +`%c' The absolute creation date. +`%C' The relative creation date." + :package-version '(forge . "0.1.0") + :group 'forge + :type 'string) + +(defcustom forge-post-fill-region t + "Whether to call `fill-region' before displaying forge posts." + :package-version '(forge . "0.1.0") + :group 'forge + :type 'boolean) + +(defcustom forge-bug-reference-hooks + '(find-file-hook + forge-post-mode-hook + git-commit-setup-hook + magit-mode-hook) + "Hooks to which `forge-bug-reference-setup' is added. +This variable has to be customized before `forge' is loaded." + :package-version '(forge . "0.2.0") + :group 'forge + :options '(find-file-hook + forge-post-mode-hook + git-commit-setup-hook + magit-mode-hook) + :type '(list :convert-widget custom-hook-convert-widget)) + +(defvar-local forge-display-in-status-buffer t + "Whether to display topics in the current Magit status buffer.") +(put 'forge-display-in-status-buffer 'permanent-local t) + +(defvar forge-format-avatar-function nil + "Function used to insert avatars in certain locations. +This is experimental and intended for users who wish to +implement such a function themselves. See #447.") + +;;; Faces +;;;; Common + +(defface forge-dimmed '((t :foreground "#93a1a1")) + "Parent face or faces used for text that shouldn't stand out. + +This face is not directly, instead several faces inherit from it +either directly or via an intermediate face. This face should +only specify the `:foreground' attribute, which is why this face +does not inherit from `magit-dimmed'." + :group 'forge-faces) + +(defface forge-topic-header-line + `((t :inherit magit-header-line + ,@(and (>= emacs-major-version 29) '(:foreground reset)))) + "Face for the `header-line' in `forge-topic-mode' buffers." + :group 'forge-faces) + +;;;; Topic and Notification Slugs + +(defface forge-topic-slug-open + '((t :inherit forge-dimmed)) + "Face uses for slugs of open topics." + :group 'forge-faces) + +(defface forge-topic-slug-completed + '((t :inherit forge-dimmed)) + "Face used for slugs of completed topics." + :group 'forge-faces) + +(defface forge-topic-slug-unplanned + '((t :inherit forge-dimmed :strike-through t)) + "Face used for slugs of unplanned topics. +E.g., for issues closes as \"unplanned\" and pull-requests that +were closed without being merged." + :group 'forge-faces) + +(defface forge-topic-slug-saved + '((t :foreground "orange")) + "Face used for slugs of topics with saved notifications." + :group 'forge-faces) + +(defface forge-topic-slug-unread + '((t :weight bold)) + "Face used for slugs of topics with unread notifications." + :group 'forge-faces) + +;;;; Topic and Notification Summaries +;;;;; Notifications + +(defface forge-topic-unread + `((t :weight bold + :box ( :line-width ,(if (>= emacs-major-version 28) (cons -1 -1) -1) + :style nil))) + "Face used for summaries of entities with unread notifications. +This face is always used together with, and takes preference +over, a `forge[-fancy]-{issue,pullreq}-STATE' face and should not +specify any attribute that is specified by any of those faces. +Likewise those faces should not set `:weight' or `:slant'." + :group 'forge-faces) + +(defface forge-topic-pending + '((t :weight bold)) + "Face used for summaries of entities with open notifications. +This face is always used together with, and takes preference +over, a `forge[-fancy]-{issue,pullreq}-STATE' face and should not +specify any attribute that is specified by any of those faces. +Likewise those faces should not set `:weight' or `:slant'." + :group 'forge-faces) + +(defface forge-topic-done + '((t :slant italic)) + "Face used for summaries of entities with no unread or open notification. +This face is always used together with, and takes preference +over, a `forge[-fancy]-{issue,pullreq}-STATE' face and should not +specify any attribute that is specified by any of those faces. +Likewise those faces should not set `:weight' or `:slant'." + :group 'forge-faces) + +;;;;; Issues + +(defface forge-issue-open + '((t)) + "Face used for summaries of open issues." + :group 'forge-faces) + +(defface forge-issue-completed + '((t :inherit forge-dimmed)) + "Face used for summaries of issues closed as completed." + :group 'forge-faces) + +(defface forge-issue-unplanned + '((t :inherit forge-dimmed :strike-through t)) + "Face used for summaries of issues closed as unplanned." + :group 'forge-faces) + +;;;;; Pull-Requests + +(defface forge-pullreq-open + '((t :foreground "LimeGreen")) + "Face used for summaries of open pull-requests." + :group 'forge-faces) + +(defface forge-pullreq-merged + '((t :foreground "MediumPurple")) + "Face used for summaries of merged pull-requests." + :group 'forge-faces) + +(defface forge-pullreq-rejected + '((t :foreground "MediumPurple" :strike-through t)) + "Face used for summaries of closed pull-requests, that weren't merged." + :group 'forge-faces) + +;;;; Labels + +(defface forge-topic-label + `((t :box ( :line-width ,(if (>= emacs-major-version 28) (cons -1 -1) -1) + :style released-button))) + "Face used for topic labels." + :group 'forge-faces) + +;;;; Post Details + +(defface forge-post-author + '((t :inherit bold)) + "Face used for post author in topic view." + :group 'forge-faces) + +(defface forge-post-date + '((t :inherit italic)) + "Face used for post date in topic view." + :group 'forge-faces) + +;;; Class + +(defclass forge-topic (forge-post) () :abstract t) + +(cl-defmethod forge--object-id ((class (subclass forge-topic)) repo number) + "Return the id for a CLASS object in REPO identified by id NUMBER." + (base64-encode-string + (encode-coding-string + (format "%s:%s%s" + (base64-decode-string (oref repo id)) + (substring (symbol-name class) + (length (oref-default class closql-class-prefix))) + number) + 'utf-8) + t)) + +(cl-defmethod forge--object-id ((prefix string) number-or-id) + (base64-encode-string + (encode-coding-string + (format "%s:%s" + (base64-decode-string prefix) + (if (numberp number-or-id) + number-or-id + ;; Currently every ID is base64 encoded. Unfortunately + ;; we cannot use the IDs of Gitlab labels (see comment + ;; in the respective `forge--update-labels' method), + ;; and have to use their names, which are not encoded. + (or (ignore-errors (base64-decode-string number-or-id)) + number-or-id))) + 'utf-8) + t)) + +(cl-defmethod forge-topic-mark-read ((topic forge-topic)) + (when (eq (oref topic status) 'unread) + (oset topic status 'pending))) + +(cl-defmethod forge--set-topic-marks ((_repo forge-repository) topic marks) + (oset topic marks + (mapcar #'car (forge-sql [:select id :from mark :where (in name $v1)] + (vconcat marks)))) + (forge-refresh-buffer)) + +;;; Query +;;;; Get + +(cl-defmethod forge-get-parent ((topic forge-topic)) + (forge-get-repository topic)) + +(cl-defmethod forge-get-repository ((topic forge-topic)) + (closql-get (forge-db) + (oref topic repository) + 'forge-repository)) + +(cl-defmethod forge-get-topic ((topic forge-topic)) + topic) + +(cl-defmethod forge-get-topic ((repo forge-repository) number-or-id) + (if (numberp number-or-id) + (if (< number-or-id 0) + (forge-get-pullreq repo (abs number-or-id)) + (or (forge-get-issue repo number-or-id) + (forge-get-pullreq repo number-or-id))) + (or (forge-get-issue number-or-id) + (forge-get-pullreq number-or-id)))) + +(cl-defmethod forge-get-topic ((number integer)) + (if (< number 0) + (forge-get-pullreq (abs number)) + (or (forge-get-issue number) + (forge-get-pullreq number)))) + +(cl-defmethod forge-get-topic ((id string)) + (or (forge-get-issue id) + (forge-get-pullreq id))) + +;;;; Current + +(defun forge-current-topic (&optional demand) + "Return the topic at point or being visited. +If there is no such topic and DEMAND is non-nil, then signal +an error." + (or (forge-topic-at-point) + forge-buffer-topic + (and demand (user-error "No current topic")))) + +(defun forge-topic-at-point (&optional demand) + "Return the topic at point. +If there is no such topic and DEMAND is non-nil, then signal +an error. If NOT-THINGATPT is non-nil, then don't use +`thing-at-point'." + (or (thing-at-point 'forge-topic) + (magit-section-value-if '(issue pullreq)) + (forge-get-pullreq :branch) + (and (derived-mode-p 'forge-topic-list-mode) + (and-let* ((id (tabulated-list-get-id))) + (forge-get-topic id))) + (and demand (user-error "No topic at point")))) + +(put 'forge-topic 'thing-at-point #'forge-thingatpt--topic) +(defun forge-thingatpt--topic () + (and-let* ((repo (forge--repo-for-thingatpt))) + (and (thing-at-point-looking-at + (if (forge-gitlab-repository--eieio-childp repo) + "\\(?2:[#!]\\)\\(?1:[0-9]+\\)\\_>" + "#\\([0-9]+\\)\\_>")) + (funcall (if (equal (match-string 2) "!") + #'forge-get-pullreq + #'forge-get-topic) + repo (string-to-number (match-string-no-properties 1)))))) + +(defun forge-region-topics () + (cond + ((derived-mode-p 'forge-notifications-mode) + (magit-region-values '(issue pullreq))) + ((and (derived-mode-p 'forge-topic-list-mode) + (region-active-p)) + (let ((beg (region-beginning)) + (end (region-end)) + (topics nil)) + (save-excursion + (goto-char beg) + (while (< (point) end) + (when-let* ((id (tabulated-list-get-id))) + (push (forge-get-topic id) topics)) + (forward-line 1)) + (nreverse topics)))))) + +;;;; List + +(defun forge-ls-recent-topics (repo table) + (let* ((id (oref repo id)) + (limit forge-topic-list-limit) + (open-limit (if (consp limit) (car limit) limit)) + (closed-limit (if (consp limit) (cdr limit) limit)) + (topics (forge-sql [:select * :from $i1 + :where (and (= repository $s2) + (= status 'unread))] + table id))) + (mapc (lambda (row) + (cl-pushnew row topics :test #'equal)) + (if (consp limit) + (forge-sql [:select * :from $i1 + :where (and (= repository $s2) + (isnull closed)) + :order-by [(desc updated)] + :limit $s3] + table id open-limit) + (forge-sql [:select * :from $i1 + :where (and (= repository $s2) + (isnull closed))] + table id))) + (when (> closed-limit 0) + (mapc (lambda (row) + (cl-pushnew row topics :test #'equal)) + (forge-sql [:select * :from $i1 + :where (and (= repository $s2) + (notnull closed)) + :order-by [(desc updated)] + :limit $s3] + table id closed-limit))) + (cl-sort (mapcar (let ((class (if (eq table 'pullreq) + 'forge-pullreq + 'forge-issue))) + (lambda (row) + (closql--remake-instance class (forge-db) row))) + topics) + (cdr forge-topic-list-order) + :key (lambda (it) (eieio-oref it (car forge-topic-list-order)))))) + +(defun forge--ls-topics (repo) + (cl-sort (nconc (forge--ls-issues repo) + (forge--ls-pullreqs repo)) + #'> :key (-cut oref <> number))) + +(defun forge--ls-active-topics (repo) + (cl-sort (nconc (forge--ls-active-issues repo) + (forge--ls-active-pullreqs repo)) + #'> :key (-cut oref <> number))) + +;;; Read + +(defun forge-read-topic (prompt) + "Read an active topic with completion using PROMPT. + +Open, unread and pending topics are considered active. +Default to the current topic even if it isn't active. + +\\While completion is in \ +progress, \\[forge-read-topic-lift-limit] lifts the limit, extending +the completion candidates to include all topics. + +If `forge-limit-topic-choices' is nil, then all candidates +can be selected from the start." + (forge--read-topic prompt + #'forge-current-topic + #'forge--ls-active-topics + #'forge--ls-topics)) + +(defun forge--read-topic (prompt current active all) + (let* ((current (funcall current)) + (repo (forge-get-repository (or current :tracked))) + (default (and current (forge--format-topic-line current))) + (alist (forge--topic-collection + (funcall (if forge-limit-topic-choices active all) + repo))) + (choices (mapcar #'car alist)) + (choices (cond ((and forge-limit-topic-choices + default + (not (member default choices))) + (push (cons default (oref current id)) alist) + (cons default choices)) + (choices))) + (choice + (if forge-limit-topic-choices + (minibuffer-with-setup-hook + (lambda () + (use-local-map (make-composed-keymap + forge-read-topic-minibuffer-map + (current-local-map)))) + (magit-completing-read + (substitute-command-keys + (format "%s \\<%s> (\\[%s] for all)" prompt + 'forge-read-topic-minibuffer-map + 'forge-read-topic-lift-limit)) + (completion-table-dynamic + (let (all-choices) + (lambda (_string) + (cond + (all-choices) + (forge-limit-topic-choices choices) + (t + (forge--replace-minibuffer-prompt (concat prompt ": ")) + (setq alist (forge--topic-collection (funcall all repo))) + (setq all-choices (mapcar #'car alist))))))) + nil t nil nil default)) + (magit-completing-read prompt choices nil t nil nil default)))) + (cdr (assoc choice alist)))) + +(defun forge--topic-collection (topics) + (mapcar (lambda (topic) + (cons (forge--format-topic-line topic) + (oref topic id))) + topics)) + +(defvar-keymap forge-read-topic-minibuffer-map + "+" #'forge-read-topic-lift-limit) + +(defun forge-read-topic-lift-limit () + "No longer limit completion candidates to active topics." + (interactive) + (when (and (minibufferp) + forge-limit-topic-choices) + (setq-local forge-limit-topic-choices nil) + (when (and (bound-and-true-p vertico-mode) + (boundp 'vertico--input) + (fboundp 'vertico--exhibit)) + (setq vertico--input t) + (vertico--exhibit)))) + +(defun forge--replace-minibuffer-prompt (prompt) + (save-excursion + (goto-char (point-min)) + (let ((inhibit-read-only t) + (end (length prompt))) + ;; (insert-and-inherit prompt) would discard all faces already + ;; present in PROMPT, so instead we do it like `read_minibuf'. + (put-text-property 0 end 'front-sticky t prompt) + (put-text-property 0 end 'rear-nonsticky t prompt) + (put-text-property 0 end 'field t prompt) + (let ((props minibuffer-prompt-properties)) + (while props + (let ((key (pop props)) + (val (pop props))) + (if (eq key 'face) + (add-face-text-property 0 end val t prompt) + (put-text-property 0 end key val prompt))))) + (insert prompt) + (delete-region (point) (minibuffer-prompt-end))))) + +(defun forge-topic-completion-at-point () + (let ((bol (line-beginning-position)) + repo) + (and (looking-back "[!#][0-9]*" bol) + (or (not bug-reference-prog-mode) + (nth 8 (syntax-ppss))) ; inside comment or string + (setq repo (forge-get-repository :tracked)) + (looking-back (if (forge--childp repo 'forge-gitlab-repository) + "\\(?3:[!#]\\)\\(?2:[0-9]*\\)" + "#\\(?2:[0-9]*\\)") + bol) + (list (match-beginning 2) + (match-end 0) + (mapcar (lambda (row) + (propertize (number-to-string (car row)) + :title (format " %s" (cadr row)))) + (if (forge--childp repo 'forge-gitlab-repository) + (forge-sql [:select [number title] + :from $i1 + :where (= repository $s2) + :order-by [(desc updated)]] + (if (equal (match-string 3) "#") + 'issue + 'pullreq) + (oref repo id)) + (forge-sql [:select [number title updated] + :from pullreq + :where (= repository $s1) + :union + :select [number title updated] + :from issue + :where (= repository $s1) + :order-by [(desc updated)]] + (oref repo id)))) + :annotation-function (lambda (c) (get-text-property 0 :title c)))))) + +(defun forge-read-topic-title (topic) + (read-string "Title: " (oref topic title))) + +(defun forge-read-topic-milestone (&optional topic) + (forge--completing-read + "Milestone" + (mapcar #'caddr (oref (forge-get-repository (or topic :tracked)) milestones)) + nil t + (and topic (forge--format-topic-milestone topic)))) + +(defun forge-read-topic-label (&optional prompt repository) + (magit-completing-read (or prompt "Label") + (forge--format-topic-label-choices + (or repository (forge-get-repository :tracked))) + nil t)) + +(defun forge-read-topic-labels (&optional topic) + (let* ((repo (forge-get-repository (or topic :tracked))) + (crm-separator ",")) + (magit-completing-read-multiple + "Labels: " + (mapcar #'cadr (oref repo labels)) + nil t + (and topic (mapconcat #'car (closql--iref topic 'labels) ","))))) + +(defun forge-read-topic-marks (&optional topic) + (let ((marks (mapcar #'car (forge-sql [:select name :from mark]))) + (crm-separator ",")) + (magit-completing-read-multiple + "Marks: " marks nil t + (and topic (mapconcat #'car (closql--iref topic 'marks) ","))))) + +(defun forge-read-topic-assignees (&optional topic) + (let* ((repo (forge-get-repository (or topic :tracked))) + (value (and topic (closql--iref topic 'assignees))) + (choices (mapcar #'cadr (oref repo assignees))) + (crm-separator ",")) + (magit-completing-read-multiple + "Assignees: " choices nil + (if (forge--childp repo 'forge-gitlab-repository) + t ; Selecting something else would fail later on. + 'confirm) + (mapconcat #'car value ",")))) + +(defun forge-read-topic-review-requests (&optional topic) + (let* ((repo (forge-get-repository (or topic :tracked))) + (value (and topic (closql--iref topic 'review-requests))) + (choices (mapcar #'cadr (oref repo assignees))) + (crm-separator ",")) + (magit-completing-read-multiple + "Request review from: " choices nil + 'confirm + (mapconcat #'car value ",")))) + +(defun forge--completing-read ( prompt collection &optional + predicate require-match initial-input + hist def) + ;; NOTE Only required until `magit-completing-read' has been + ;; updated to allow empty input if require-match is t. + (let ((reply (funcall magit-completing-read-function + (concat prompt ": ") + (if (and def (not (member def collection))) + (cons def collection) + collection) + predicate + require-match initial-input hist def))) + (if (equal reply "") + (if (and require-match (not (eq require-match t))) + (user-error "Nothing selected") + nil) + reply))) + +;;; Format + +(cl-defmethod forge--format ((topic forge-topic) slot &optional spec) + (forge--format (forge-get-repository topic) slot + `(,@spec (?i . ,(oref topic number))))) + +(defun forge--format-topic-line (topic &optional width) + (concat + (and (derived-mode-p 'forge-notifications-mode) + (eq forge-notifications-display-style 'flat) + (concat (truncate-string-to-width + (oref (forge-get-repository topic) slug) + forge-notifications-repo-slug-width + nil ?\s t) + " ")) + ;; MAYBE bring this back once we support discussions. + ;; (cond (no-indicator nil) + ;; ((forge-issue-p topic) (magit--propertize-face "I " 'magit-dimmed)) + ;; ((forge-pullreq-p topic) (magit--propertize-face "P " 'magit-dimmed)) + ;; (t (magit--propertize-face "* " 'error))) + (string-pad (forge--format-topic-slug topic) (or width 5)) + " " + (forge--format-topic-title topic))) + +(defun forge--format-topic-slug (topic) + (with-slots (slug state status saved-p) topic + (magit--propertize-face + slug + `(,@(and saved-p '(forge-topic-slug-saved)) + ,@(and (eq status 'unread) '(forge-topic-slug-unread)) + ,(pcase state + ('open 'forge-topic-slug-open) + ((or 'completed 'merged) 'forge-topic-slug-completed) + ((or 'unplanned 'rejected) 'forge-topic-slug-unplanned)))))) + +(defun forge--format-topic-refs (topic) + (pcase-let + (((eieio cross-repo-p base-repo base-ref head-repo head-ref) topic) + (separator (magit--propertize-face ":" 'magit-dimmed)) + (deleted (magit--propertize-face "(deleted)" 'magit-dimmed))) + (concat (if cross-repo-p + (concat base-repo separator base-ref) + base-ref) + (magit--propertize-face "..." 'magit-dimmed) + (if cross-repo-p + (if (and head-repo head-ref) + (concat head-repo separator head-ref) + deleted) + (or head-ref deleted))))) + +(defun forge--format-topic-draft (topic) + (if (oref topic draft-p) + (magit--propertize-face "yes" 'bold) + (magit--propertize-face "no" 'magit-dimmed))) + +(defun forge--format-topic-saved (topic) + (if (oref topic saved-p) + (magit--propertize-face "yes" 'bold) + (magit--propertize-face "no" 'magit-dimmed))) + +(defun forge--format-topic-title (topic) + (with-slots (title status state) topic + (magit-log-propertize-keywords + nil + (magit--propertize-face + title + `(,(pcase status + ('unread 'forge-topic-unread) + ('pending 'forge-topic-pending) + ('done 'forge-topic-done)) + ,(pcase (list (eieio-object-class topic) state) + (`(forge-issue open) 'forge-issue-open) + (`(forge-issue completed) 'forge-issue-completed) + (`(forge-issue unplanned) 'forge-issue-unplanned) + (`(forge-pullreq open) 'forge-pullreq-open) + (`(forge-pullreq merged) 'forge-pullreq-merged) + (`(forge-pullreq rejected) 'forge-pullreq-rejected))))))) + +(defun forge--format-topic-title+labels (topic) + (concat (forge--format-topic-title topic) " " + (forge--format-topic-labels topic))) + +(defun forge--format-topic-milestone (topic) + (and-let* ((id (oref topic milestone))) + (caar (forge-sql [:select [title] :from milestone :where (= id $s1)] id)))) + +(defun forge--format-topic-labels (topic) + (and-let* ((labels (closql--iref topic 'labels))) + (mapconcat (pcase-lambda (`(,name ,color ,_description)) + (let* ((background (forge--sanitize-color color)) + (foreground (forge--contrast-color background))) + (magit--propertize-face + name `(( :background ,background + :foreground ,foreground) + forge-tablist-topic-label)))) + labels " "))) + +(defun forge--format-topic-label-choices (repo) + (mapcar (pcase-lambda (`(,_id ,name ,color ,_description)) + (let* ((background (forge--sanitize-color color)) + (foreground (forge--contrast-color background))) + (magit--propertize-face + name `( :background ,background + :foreground ,foreground)))) + (oref repo labels))) + +(defun forge--format-topic-marks (topic) + (and-let* ((marks (closql--iref topic 'marks))) + (mapconcat (pcase-lambda (`(,name ,face ,_description)) + (magit--propertize-face + name (list 'forge-tablist-topic-label face))) + marks " "))) + +(defun forge--format-topic-state (topic) + (with-slots (state) topic + (magit--propertize-face + (symbol-name state) + (pcase (list (if (forge-issue-p topic) 'issue 'pullreq) state) + ('(issue open) 'forge-issue-open) + ('(issue closed) 'forge-issue-completed) + ('(issue completed) 'forge-issue-completed) + ('(issue unplanned) 'forge-issue-unplanned) + ('(pullreq open) 'forge-pullreq-open) + ('(pullreq merged) 'forge-pullreq-merged) + ('(pullreq closed) 'forge-pullreq-rejected))))) + +(defun forge--format-topic-status (topic) + (with-slots (status) topic + (magit--propertize-face + (symbol-name status) + (pcase status + ('unread 'forge-topic-unread) + ('pending 'forge-topic-pending) + ('done 'forge-topic-done))))) + +(defun forge--format-topic-assignees (topic) + (and-let* ((assignees (closql--iref topic 'assignees))) + (mapconcat #'forge--format-person assignees ", "))) + +(defun forge--format-topic-review-requests (topic) + (and-let* ((review-requests (closql--iref topic 'review-requests))) + (mapconcat #'forge--format-person review-requests ", "))) + +(defun forge--format-person (person) + (pcase-let ((`(,login ,name) person)) + (format "%s%s (@%s)" + (forge--format-avatar login) + name login))) + +(defun forge--format-avatar (person) + (if forge-format-avatar-function + (funcall forge-format-avatar-function person) + "")) + +(defun forge--format-boolean (slot name) + ;; Booleans are formatted differently in transients and headers. + ;; Use this to format the (complete) description of suffix commands. + (let ((topic (forge-current-topic))) + (if (and topic (slot-exists-p topic slot)) + (format (propertize "[%s]" 'face 'transient-delimiter) + (propertize name 'face + (if (eieio-oref topic slot) + 'transient-value + 'transient-inactive-value))) + (format "[%s]" name)))) + +;;; Insert + +(defun forge--insert-topics (type heading topics) + (when topics + (let ((width (apply #'max (--map (length (oref it slug)) topics)))) + (magit-insert-section ((eval type) nil t) + (magit-insert-heading + (concat (magit--propertize-face (concat heading " ") + 'magit-section-heading) + (magit--propertize-face (format "(%s)" (length topics)) + 'magit-section-child-count))) + (magit-insert-section-body + (dolist (topic topics) + (forge--insert-topic topic width)) + (insert ?\n) + (magit-make-margin-overlay nil t)))))) + +(defun forge--insert-topic (topic &optional width) + (magit-insert-section ((eval (oref topic closql-table)) topic t) + (insert (forge--format-topic-line topic (or width 5))) + (forge--insert-topic-marks topic t) + (forge--insert-topic-labels topic t) + (insert "\n") + (magit-log-format-author-margin + (oref topic author) + (format-time-string "%s" (parse-iso8601-time-string (oref topic created))) + t) + (when (and (slot-exists-p topic 'merged) + (not (oref topic merged))) + (magit-insert-heading) + (magit-insert-section-body + (forge--insert-pullreq-commits topic))))) + +(defun forge--insert-topic-labels (topic &optional separate) + (and-let* ((labels (closql--iref topic 'labels))) + (prog1 t + (pcase-dolist (`(,name ,color ,description) labels) + (let* ((background (forge--sanitize-color color)) + (foreground (forge--contrast-color background))) + (if separate (insert " ") (setq separate t)) + (insert name) + (let ((o (make-overlay (- (point) (length name)) (point)))) + (overlay-put o 'priority 2) + (overlay-put o 'evaporate t) + (overlay-put o 'font-lock-face + `(( :background ,background + :foreground ,foreground) + forge-topic-label)) + (when description + (overlay-put o 'help-echo description)))))))) + +(defun forge--insert-topic-marks (topic &optional separate) + (and-let* ((marks (closql--iref topic 'marks))) + (prog1 t + (pcase-dolist (`(,name ,face ,description) marks) + (if separate (insert " ") (setq separate t)) + (insert name) + (let ((o (make-overlay (- (point) (length name)) (point)))) + (overlay-put o 'priority 2) + (overlay-put o 'evaporate t) + (overlay-put o 'font-lock-face (list face 'forge-topic-label)) + (when description + (overlay-put o 'help-echo description))))))) + +(defun forge--assert-insert-topics-get-repository (&optional issues-p) + (and (forge-db t) + (or forge-display-in-status-buffer + (not (eq major-mode 'magit-status-mode))) + (and-let* ((repo (forge-get-repository :tracked?))) + (and (or (not issues-p) + (oref repo issues-p)) + repo)))) + +;;; Modes + +(defvar-keymap forge-post-section-map + " " #'forge-edit-post + "C-c C-k" #'forge-delete-comment) + +(defvar-keymap forge-topic-mode-map + " " #'markdown-follow-link-at-point + "" #'markdown-follow-link-at-point + "C-c C-m" #'forge-topic-menu + "C-c C-n" #'forge-create-post + "C-c C-r" #'forge-create-post) + +(define-derived-mode forge-topic-mode magit-mode "Topic" + "Parent mode of `forge-{issue,pullreq}-mode'. +This mode itself is never used directly." + (face-remap-add-relative 'header-line 'forge-topic-header-line) + (setq-local markdown-translate-filename-function + #'forge--markdown-translate-filename-function)) + +(define-derived-mode forge-issue-mode forge-topic-mode "Issue" + "Mode for looking at a Forge issue.") +(defalias 'forge-issue-setup-buffer #'forge-topic-setup-buffer) +(defalias 'forge-issue-refresh-buffer #'forge-topic-refresh-buffer) +(defvar forge-issue-headers-hook + '(forge-insert-topic-state + forge-insert-topic-status + forge-insert-topic-milestone + forge-insert-topic-labels + forge-insert-topic-marks + forge-insert-topic-assignees)) + +(define-derived-mode forge-pullreq-mode forge-topic-mode "Pull-request" + "Mode for looking at a Forge pull-request.") +(defalias 'forge-pullreq-setup-buffer #'forge-topic-setup-buffer) +(defalias 'forge-pullreq-refresh-buffer #'forge-topic-refresh-buffer) +(defvar forge-pullreq-headers-hook + '(forge-insert-topic-state + forge-insert-topic-draft + forge-insert-topic-status + forge-insert-topic-saved + forge-insert-topic-refs + forge-insert-topic-milestone + forge-insert-topic-labels + forge-insert-topic-marks + forge-insert-topic-assignees + forge-insert-topic-review-requests)) + +(defvar-local forge-buffer-topic nil) + +(defun forge-topic-setup-buffer (topic) + (let* ((repo (forge-get-repository topic)) + (name (format "*forge: %s %s*" (oref repo slug) (oref topic slug))) + (magit-generate-buffer-name-function (lambda (_mode _value) name)) + (current-repo (forge-get-repository :known?)) + (default-directory (if (forge-repository-equal current-repo repo) + default-directory + (or (forge-get-worktree repo) + default-directory)))) + (magit-setup-buffer-internal + (if (forge-issue-p topic) #'forge-issue-mode #'forge-pullreq-mode) + t `((forge-buffer-topic ,topic)) name) + (forge-topic-mark-read topic))) + +(defun forge-topic-refresh-buffer () + (let ((topic (closql-reload forge-buffer-topic))) + (setq forge-buffer-topic topic) + (magit-set-header-line-format (forge--format-topic-line topic)) + (magit-insert-section (topicbuf) + (magit-insert-headers + (intern (format "%s-headers-hook" + (substring (symbol-name major-mode) 0 -5)))) + (when (forge-pullreq-p topic) + (magit-insert-section (pullreq topic) + (magit-insert-heading "Commits") + (forge--insert-pullreq-commits topic t))) + (when-let ((note (oref topic note))) + (magit-insert-section (note) + (magit-insert-heading "Note") + (insert (forge--fontify-markdown note) "\n\n"))) + (dolist (post (cons topic (oref topic posts))) + (with-slots (author created body) post + (magit-insert-section section (post post) + (oset section heading-highlight-face + 'magit-diff-hunk-heading-highlight) + (let ((heading + (format-spec + forge-post-heading-format + `((?a . ,(propertize (concat (forge--format-avatar author) + (or author "(ghost)")) + 'font-lock-face 'forge-post-author)) + (?c . ,(propertize created 'font-lock-face 'forge-post-date)) + (?C . ,(propertize (apply #'format "%s %s ago" + (magit--age + (float-time + (date-to-time created)))) + 'font-lock-face 'forge-post-date)))))) + (font-lock-append-text-property + 0 (length heading) + 'font-lock-face 'magit-diff-hunk-heading heading) + (magit-insert-heading heading)) + (insert (forge--fontify-markdown body) "\n\n")))) + (when (and (display-images-p) + (fboundp 'markdown-display-inline-images)) + (let ((markdown-display-remote-images t)) + (markdown-display-inline-images)))))) + +(cl-defmethod magit-buffer-value (&context (major-mode forge-topic-mode)) + (oref forge-buffer-topic slug)) + +;;; Headers + +(cl-defmacro forge--define-topic-header + (name &key insert format (command nil command?)) + (declare (indent defun)) + (let ((fun (intern (format "forge-insert-topic-%s" name))) + (map (intern (format "forge-topic-%s-section-map" name))) + (cmd (intern (format "forge-topic-set-%s" name)))) + `(progn + (cl-defun ,fun (&optional (topic forge-buffer-topic)) + (magit-insert-section (,(intern (format "topic-%s" name))) + (insert ,(capitalize (string-pad (format "%s: " name) 11))) + ,(cond + (insert + `(unless (funcall ,insert topic) + (insert (magit--propertize-face "none" 'magit-dimmed)))) + (format + `(insert (or (funcall ,format topic) + (magit--propertize-face "none" 'magit-dimmed))))) + (insert ?\n))) + ,@(and (if command? command t) + `((defvar-keymap ,map " " + ,(or command `(function ,cmd))) + (put ',fun 'definition-name ',name))) + (put ',map 'definition-name ',name)))) + +(forge--define-topic-header refs + :command nil + :format #'forge--format-topic-refs) + +(forge--define-topic-header draft + :command #'forge-topic-toggle-draft + :format #'forge--format-topic-draft) + +(forge--define-topic-header saved + :command #'forge-topic-toggle-saved + :format #'forge--format-topic-saved) + +(forge--define-topic-header state + :command #'forge-topic-state-menu + :format #'forge--format-topic-state) + +(forge--define-topic-header status + :command #'forge-topic-status-menu + :format #'forge--format-topic-status) + +(forge--define-topic-header milestone + :format #'forge--format-topic-milestone) + +(forge--define-topic-header labels + :insert #'forge--insert-topic-labels) + +(forge--define-topic-header marks + :insert #'forge--insert-topic-marks) + +(forge--define-topic-header assignees + :format #'forge--format-topic-assignees) + +(forge--define-topic-header review-requests + :format #'forge--format-topic-review-requests) + +;;; Commands +;;;; Groups + +(defconst forge--topic-set-state-group + ["Set state" + ("s o" forge-topic-state-set-open) + ("s c" forge-issue-state-set-completed) + ("s u" forge-issue-state-set-unplanned) + ("s m" forge-pullreq-state-set-merged) + ("s r" forge-pullreq-state-set-rejected) + ""]) + +(defconst forge--topic-set-status-group + ["Set status" + ("s i" forge-topic-status-set-unread) + ("s p" forge-topic-status-set-pending) + ("s d" forge-topic-status-set-done)]) + +(defconst forge--topic-set-slots-group + ["Set" + ("e t" forge-topic-set-title) + ("e m" forge-topic-set-milestone) + ("e l" forge-topic-set-labels) + ("e a" forge-topic-set-assignees) + ("e r" forge-topic-set-review-requests) + ("e d" forge-topic-toggle-draft)]) + +(defconst forge--topic-set-local-group + ["Set local" + ("l s" forge-topic-toggle-saved) + ("l m" forge-topic-set-marks) + ("l n" forge-edit-topic-note)]) + +;;;; Menus + +(defconst forge--topic-menus-column-widths '(19)) + +;;;###autoload (autoload 'forge-topic-menu "forge-topic" nil t) +(transient-define-prefix forge-topic-menu () + "Edit the topic at point." + :transient-suffix t + :transient-non-suffix t + :transient-switch-frame nil + :refresh-suffixes t + :column-widths forge--topic-menus-column-widths + [:hide always + ("q" forge-menu-quit-list)] + [["Actions" + ("f" forge-pull-this-topic) + ("b" forge-browse-this-topic) + ("k" forge-delete-comment) + ("p" forge-create-pullreq-from-issue) + ("m" "show more actions" forge-dispatch)]] + [forge--topic-set-state-group + forge--topic-set-slots-group] + [forge--topic-set-status-group + forge--topic-set-local-group] + (interactive) + (unless (derived-mode-p 'forge-topic-mode) + (if-let ((topic (forge-topic-at-point))) + (forge-topic-setup-buffer topic) + (user-error "No current topic"))) + (transient-setup 'forge-topic-menu)) + +;;;###autoload (autoload 'forge-topic-state-menu "forge-topic" nil t) +(transient-define-prefix forge-topic-state-menu () + "Set state of the current topic." + [("o" forge-topic-state-set-open) + ("c" forge-issue-state-set-completed) + ("u" forge-issue-state-set-unplanned) + ("m" forge-pullreq-state-set-merged) + ("r" forge-pullreq-state-set-rejected)]) + +;;;###autoload (autoload 'forge-topic-status-menu "forge-topic" nil t) +(transient-define-prefix forge-topic-status-menu () + "Set status of the current topic." + [("i" forge-topic-status-set-unread) + ("p" forge-topic-status-set-pending) + ("d" forge-topic-status-set-done)]) + +;;;; State + +(defclass forge--topic-set-state-command (transient-suffix) + ((state :initarg :state) + (getter :initarg :getter) + (definition + :initform (lambda () + (interactive) + (with-slots (getter state) (transient-suffix-object) + (let ((topic (funcall getter t))) + (forge--set-topic-state (forge-get-repository topic) + topic state))))) + (description + :initform (lambda (obj) + (symbol-name (oref obj state)))) + (inapt-if + :initform (lambda () + (or (forge-region-topics) + (with-slots (getter state) (transient-suffix-object) + (if-let ((topic (funcall getter))) + ;; Once a pull-request is merged, + ;; its state cannot be changed anymore. + (memq (oref topic state) (list state 'merged)) + t))))) + (inapt-face + :initform (lambda (obj) + (with-slots (getter state) (transient-suffix-object) + (if (and (not (forge-region-topics)) + (and-let* ((topic (funcall getter))) + (eq (oref topic state) state))) + 'forge-suffix-active + 'transient-inapt-suffix)))))) + +(transient-define-suffix forge-topic-state-set-open () + "Set the state of the current topic to `open'." + :class 'forge--topic-set-state-command + :state 'open + :getter #'forge-current-topic) + +(transient-define-suffix forge-issue-state-set-completed () + "Set the state of the current issue to `completed'." + :class 'forge--topic-set-state-command + :state 'completed + :getter #'forge-current-issue) + +(transient-define-suffix forge-issue-state-set-unplanned () + "Set the state of the current issue to `unplanned'." + :class 'forge--topic-set-state-command + :state 'unplanned + :getter #'forge-current-issue) + +(transient-define-suffix forge-pullreq-state-set-merged () + "If the current pull-request is merged, then visualize that." + :class 'forge--topic-set-state-command + :state 'merged + :getter #'forge-current-pullreq + (interactive) + (message "Please use a merge command for this")) + +(transient-define-suffix forge-pullreq-state-set-rejected () + "Set the state of the current pull-request to `rejected'." + :class 'forge--topic-set-state-command + :state 'rejected + :getter #'forge-current-pullreq) + +;;;; Status + +(defclass forge--topic-set-status-command (transient-suffix) + ((status :initarg :status) + (definition + :initform (lambda () + (interactive) + (with-slots (status) (transient-suffix-object) + (if-let ((topics (forge-region-topics))) + (dolist (topic topics) + (oset topic status status)) + (oset (forge-current-topic t) status status))) + (forge-refresh-buffer))) + (description + :initform (lambda (obj) + (symbol-name (oref obj status)))) + (inapt-if + :initform (lambda () + (and (not (forge-region-topics)) + (if-let ((topic (forge-current-topic))) + (eq (oref topic status) + (oref (transient-suffix-object) status)) + t)))) + (inapt-face + :initform (lambda () + (if (forge-current-topic) + 'forge-suffix-active + 'transient-inapt-suffix))))) + +(transient-define-suffix forge-topic-status-set-unread () + "Set the notification status of the current topic to `unread'." + :class 'forge--topic-set-status-command :status 'unread) + +(transient-define-suffix forge-topic-status-set-pending () + "Set the notification status of the current topic to `pending'." + :class 'forge--topic-set-status-command :status 'pending) + +(transient-define-suffix forge-topic-status-set-done () + "Set the notification status of the current topic to `done'." + :class 'forge--topic-set-status-command :status 'done) + +;;;; Set + +(defclass forge--topic-set-slot-command (transient-suffix) + ((slot :initarg :slot) + (setter) + (reader) + (formatter :initarg :formatter) + (definition + :initform (lambda (value) + (interactive + (list (funcall (oref (transient-suffix-object) reader) + (forge-current-topic t)))) + (let ((topic (forge-current-topic t))) + (funcall (oref (transient-suffix-object) setter) + (forge-get-repository topic) + topic value)))) + (description + :initform (lambda (obj) + (with-slots (slot inapt-if-not) obj + (if-let* ((topic (if inapt-if-not + (funcall inapt-if-not) + (forge-current-topic))) + (value (funcall (oref obj formatter) topic))) + (format "%s %s" slot value) + (format "%s" slot))))))) + +(cl-defmethod initialize-instance :after + ((obj forge--topic-set-slot-command) &optional _slots) + (with-slots (slot) obj + (let ((name (symbol-name slot))) + (cond ((string-suffix-p "-p" name) + (setq name (substring name 0 -2)) + (oset obj reader (lambda (topic) (not (eieio-oref topic slot))))) + ((oset obj reader (intern (format "forge-read-topic-%s" name))))) + (oset obj setter (intern (format "forge--set-topic-%s" name))) + (unless (slot-boundp obj 'formatter) + (oset obj formatter (intern (format "forge--format-topic-%s" name))))))) + +(transient-define-suffix forge-topic-set-title (title) + "Edit the TITLE of the current topic." + :class 'forge--topic-set-slot-command :slot 'title + :formatter (lambda (topic) + (propertize (forge--format-topic-title topic) + 'face 'font-lock-string-face))) + +(transient-define-suffix forge-topic-set-milestone (milestone) + "Edit what MILESTONE the current topic belongs to." + :class 'forge--topic-set-slot-command :slot 'milestone) + +(transient-define-suffix forge-topic-set-labels (labels) + "Edit the LABELS of the current topic." + :class 'forge--topic-set-slot-command :slot 'labels) + +(transient-define-suffix forge-topic-set-marks (marks) + "Edit the MARKS of the current topic." + :class 'forge--topic-set-slot-command :slot 'marks) + +(transient-define-suffix forge-topic-set-assignees (assignees) + "Edit the ASSIGNEES of the current topic." + :class 'forge--topic-set-slot-command :slot 'assignees) + +(transient-define-suffix forge-topic-set-review-requests (review-requests) + "Edit the REVIEW-REQUESTS of the current pull-request." + :class 'forge--topic-set-slot-command :slot 'review-requests + :inapt-if-not #'forge-current-pullreq) + +(transient-define-suffix forge-topic-toggle-draft (draft) + "Toggle whether the current pull-request is a draft." + :class 'forge--topic-set-slot-command :slot 'draft-p + :inapt-if-not #'forge-current-pullreq + :description (lambda () (forge--format-boolean 'draft-p "draft"))) + +(transient-define-suffix forge-topic-toggle-saved () + "Toggle whether this topic is marked as saved." + :class 'forge--topic-set-slot-command :slot 'saved-p + :description (lambda () (forge--format-boolean 'saved-p "saved")) + ;; Set only locally because Github's API does not support this. + (interactive) + (let ((topic (forge-current-topic t))) + (oset topic saved-p (not (oref topic saved-p)))) + (forge-refresh-buffer)) + +;;; Color Utilities + +(defun forge--sanitize-color (color) + (cond ((color-values color) color) + ;; Discard alpha information. + ((string-match-p "\\`#.\\{4\\}\\'" color) (substring color 0 3)) + ((string-match-p "\\`#.\\{8\\}\\'" color) (substring color 0 6)) + (t "#000000"))) ; Use fallback instead of invalid color. + +(defun forge--contrast-color (color) + "Return black or white depending on the luminance of COLOR." + (if (> (forge--x-color-luminance color) 0.5) "black" "white")) + +;; Copy of `rainbow-x-color-luminance'. +(defun forge--x-color-luminance (color) + "Calculate the luminance of a color string (e.g., \"#ffaa00\", \"blue\"). +Return a value between 0 and 1." + (let ((values (color-values color))) + (forge--color-luminance (/ (nth 0 values) 256.0) + (/ (nth 1 values) 256.0) + (/ (nth 2 values) 256.0)))) + +;; Copy of `rainbow-color-luminance'. +;; Also see https://en.wikipedia.org/wiki/Relative_luminance. +(defun forge--color-luminance (red green blue) + "Calculate the luminance of color composed of RED, GREEN and BLUE. +Return a value between 0 and 1." + (/ (+ (* .2126 red) (* .7152 green) (* .0722 blue)) 256)) + +;;; Markdown Utilities + +(defun forge--fontify-markdown (text) + (with-temp-buffer + (delay-mode-hooks + (gfm-mode)) + (insert text) + (font-lock-ensure) + (when forge-post-fill-region + (fill-region (point-min) (point-max))) + (buffer-string))) + +(defun forge--markdown-translate-filename-function (file) + (if (string-match-p "\\`https?://" file) + file + (let ((host (oref (forge-get-repository :tracked) forge))) ;aka webhost + (concat (if (member host ghub-insecure-hosts) "http://" "https://") + host + (and (not (string-prefix-p "/" file)) "/") + file)))) + +;;; Templates + +(defun forge--topic-parse-buffer (&optional file) + (save-match-data + (save-excursion + (goto-char (point-min)) + (let ((alist (save-excursion (forge--topic-parse-yaml)))) + (if alist + (setf (alist-get 'yaml alist) t) + (setq alist (save-excursion (forge--topic-parse-plain)))) + (setf (alist-get 'file alist) file) + (setf (alist-get 'text alist) (magit--buffer-string nil nil ?\n)) + (when (and file (not (alist-get 'prompt alist))) + (setf (alist-get 'prompt alist) + (file-name-sans-extension (file-name-nondirectory file)))) + ;; If there is a yaml front-matter, then it is supposed + ;; to have a `title' field, but this may not be the case. + (when (and (not file) + (not (alist-get 'title alist))) + (setf (alist-get 'title alist) + (read-string "Title: "))) + alist)))) + +(defun forge--topic-parse-yaml () + (let (alist beg end) + (when (looking-at "^---[\s\t]*$") + (forward-line) + (setq beg (point)) + (when (re-search-forward "^---[\s\t]*$" nil t) + (setq end (match-beginning 0)) + (setq alist (yaml-parse-string + (buffer-substring-no-properties beg end) + :object-type 'alist + :sequence-type 'list + ;; FIXME Does not work because of + ;; https://github.com/zkry/yaml.el/pull/28. + :false-object nil)) + (let-alist alist + (when (and .name .about) + (setf (alist-get 'prompt alist) + (format "[%s] %s" .name .about))) + (when (and .labels (atom .labels)) + (setf (alist-get 'labels alist) (list .labels))) + (when (and .assignees (atom .assignees)) + (setf (alist-get 'assignees alist) (list .assignees)))) + (forward-line) + (when (and (not (alist-get 'title alist)) + (looking-at "^\n?#*")) + (goto-char (match-end 0)) + (setf (alist-get 'title alist) + (string-trim + (magit--buffer-string (point) (line-end-position) t))) + (forward-line)) + (setf (alist-get 'body alist) + (string-trim (magit--buffer-string (point) nil ?\n))))) + alist)) + +(defun forge--topic-parse-plain () + (let (title body) + (when (looking-at "\\`#*") + (goto-char (match-end 0))) + (setq title (magit--buffer-string (point) (line-end-position) t)) + (forward-line) + (setq body (magit--buffer-string (point) nil ?\n)) + `((title . ,(string-trim title)) + (body . ,(string-trim body))))) + +(defun forge--topic-parse-link-buffer () + (save-match-data + (save-excursion + (goto-char (point-min)) + (mapcar (lambda (alist) + (cons (cons 'prompt (concat (alist-get 'name alist) " -- " + (alist-get 'about alist))) + alist)) + (forge--topic-parse-yaml-links))))) + +(defun forge--topic-parse-yaml-links () + (alist-get 'contact_links + (yaml-parse-string (buffer-substring-no-properties + (point-min) + (point-max)) + :object-type 'alist + :sequence-type 'list))) + +(cl-defgeneric forge--topic-template-files (repo class) + "Return a list of topic template files for REPO and a topic of CLASS.") + +(cl-defgeneric forge--topic-template (repo class) + "Return a topic template alist for REPO and a topic of CLASS. +If there are multiple templates, then the user is asked to select +one of them. It there are no templates, then return a very basic +alist, containing just `text' and `position'.") + +(defun forge--topic-templates-data (repo class) + (let ((branch (oref repo default-branch))) + (mapcan (lambda (f) + (with-temp-buffer + (magit-git-insert "cat-file" "-p" (concat branch ":" f)) + (if (equal (file-name-nondirectory f) "config.yml") + (forge--topic-parse-link-buffer) + (list (forge--topic-parse-buffer f))))) + (forge--topic-template-files repo class)))) + +(cl-defmethod forge--topic-template ((repo forge-repository) + (class (subclass forge-topic))) + (let ((choices (forge--topic-templates-data repo class))) + (if (cdr choices) + (let ((c (magit-completing-read + (if (eq class 'forge-pullreq) + "Select pull-request template" + "Select issue template") + (--map (alist-get 'prompt it) choices) + nil t))) + (--first (equal (alist-get 'prompt it) c) choices)) + (car choices)))) + +;;; Bug-Reference + +(when (< emacs-major-version 28) + (defun bug-reference-fontify (start end) + "Apply bug reference overlays to region." + (save-excursion + (let ((beg-line (progn (goto-char start) (line-beginning-position))) + (end-line (progn (goto-char end) (line-end-position)))) + ;; Remove old overlays. + (bug-reference-unfontify beg-line end-line) + (goto-char beg-line) + (while (and (< (point) end-line) + (re-search-forward bug-reference-bug-regexp end-line 'move)) + (when (and (or (not bug-reference-prog-mode) + ;; This tests for both comment and string syntax. + (nth 8 (syntax-ppss))) + ;; This is the part where this redefinition differs + ;; from the original defined in "bug-reference.el". + (not (and (derived-mode-p 'magit-status-mode + 'forge-notifications-mode) + (= (match-beginning 0) + (line-beginning-position)))) + ;; End of additions. + ) + (let ((overlay (make-overlay (match-beginning 0) (match-end 0) + nil t nil))) + (overlay-put overlay 'category 'bug-reference) + ;; Don't put a link if format is undefined + (when bug-reference-url-format + (overlay-put overlay 'bug-reference-url + (if (stringp bug-reference-url-format) + (format bug-reference-url-format + (match-string-no-properties 2)) + (funcall bug-reference-url-format))))))))))) + +(defun forge-bug-reference-setup () + "Setup `bug-reference' in the current buffer. +If forge data has been fetched for the current repository, then +enable `bug-reference-mode' or `bug-reference-prog-mode' and +modify `bug-reference-bug-regexp' if appropriate." + (unless (or bug-reference-url-format + (not (forge-db t)) + ;; TODO Allow use in this mode again. + (derived-mode-p 'forge-notifications-mode)) + (magit--with-safe-default-directory nil + (when-let ((repo (forge-get-repository :tracked?))) + (if (>= emacs-major-version 28) + (when (derived-mode-p 'magit-status-mode + 'forge-notifications-mode) + (setq-local + bug-reference-auto-setup-functions + (let ((hook bug-reference-auto-setup-functions)) + (list (lambda () + ;; HOOK is not allowed to be a lexical var: + ;; (run-hook-with-args-until-success 'hook) + (catch 'success + (dolist (f hook) + (when (funcall f) + (setq bug-reference-bug-regexp + (concat "." bug-reference-bug-regexp)) + (throw 'success t))))))))) + (setq-local bug-reference-url-format + (if (forge--childp repo 'forge-gitlab-repository) + (lambda () + (forge--format repo + (if (equal (match-string 3) "#") + 'issue-url-format + 'pullreq-url-format) + `((?i . ,(match-string 2))))) + (forge--format repo 'issue-url-format '((?i . "%s"))))) + (setq-local bug-reference-bug-regexp + (if (forge--childp repo 'forge-gitlab-repository) + "\\(?3:[!#]\\)\\(?2:[0-9]+\\)" + "#\\(?2:[0-9]+\\)"))) + (if (derived-mode-p 'prog-mode) + (bug-reference-prog-mode 1) + (bug-reference-mode 1)) + (add-hook 'completion-at-point-functions + #'forge-topic-completion-at-point nil t))))) + +(unless noninteractive + (dolist (hook forge-bug-reference-hooks) + (add-hook hook #'forge-bug-reference-setup))) + +;;; _ +(provide 'forge-topic) +;;; forge-topic.el ends here diff --git a/elpa/forge-20240523.1103/forge-topics.el b/elpa/forge-20240523.1103/forge-topics.el new file mode 100644 index 00000000..ddf81e4f --- /dev/null +++ b/elpa/forge-20240523.1103/forge-topics.el @@ -0,0 +1,488 @@ +;;; forge-topics.el --- List topics -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2024 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . + +;;; Code: + +(require 'hl-line) + +(require 'forge-topic) +(require 'forge-tablist) + +(defvar x-stretch-cursor) + +;;; Options + +(defcustom forge-topic-list-mode-hook '(hl-line-mode) + "Hook run after entering Forge-Topic-List mode." + :package-version '(forge . "0.1.0") + :group 'forge + :type 'hook + :options '(hl-line-mode)) + +(defcustom forge-topic-list-columns + '(("#" forge--format-topic-slug 5 nil nil) + ("Title" forge--format-topic-title+labels 35 nil nil)) + "List of columns displayed when listing topics for a single repository. + +Each element has the form (HEADER SOURCE WIDTH SORT PROPS). + +HEADER is the string displayed in the header. WIDTH is the width +of the column. SOURCE is used to get the value, it has to be the +name of a slot of `forge-topic' or a function that takes such an +object as argument. SORT is a boolean or a function used to sort +by this column. Supported PROPS include `:right-align' and +`:pad-right'." + :package-version '(forge . "0.4.0") + :group 'forge + :type forge--tablist-columns-type) + +(defcustom forge-global-topic-list-columns + '(("Owner" (repository owner) 15 nil nil) + ("Name" (repository name) 20 nil nil) + ("#" forge--format-topic-slug 5 nil nil) + ("Title" forge--format-topic-title+labels 35 nil nil)) + "List of columns displayed when listing topics for all repositories. + +Each element has the form (HEADER SOURCE WIDTH SORT PROPS). + +HEADER is the string displayed in the header. WIDTH is the width +of the column. SOURCE is used to get the value, it has to be the +name of a slot of `forge-topic' or a function that takes such an +object as argument. SORT is a boolean or a function used to sort +by this column. Supported PROPS include `:right-align' and +`:pad-right'." + :package-version '(forge . "0.4.0") + :group 'forge + :type forge--tablist-columns-type) + +(defcustom forge-owned-accounts nil + "An alist of accounts that are owned by you. +This should include your username as well as any organization +that you own. Used by the commands `forge-list-owned-issues', +`forge-list-owned-pullreqs' and `forge-fork'. + +Each element has the form (ACCOUNT . PLIST). The following +properties are currently being used: + +`remote-name' The default name suggested by `forge-fork' for a + fork created within this account. If unspecified, then the + name of the account is used." + :package-version '(forge . "0.2.0") + :group 'forge + :type '(repeat (cons (string :tag "Account") plist))) + +(defcustom forge-owned-ignored nil + "A list of repositories that are ignored when listing those owned by you. +This is a list of package names. Used by the commands +`forge-list-owned-issues' and `forge-list-owned-pullreqs'." + :package-version '(forge . "0.2.0") + :group 'forge + :type '(repeat (string :tag "Name"))) + +;;; Faces + +(defface forge-suffix-active '((t :inherit transient-value)) + "Face used for suffixes whose effects is currently active." + :group 'forge-faces) + +(defface forge-tablist-hl-line + `((((class color) (background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :box ( :line-width ,(if (>= emacs-major-version 28) (cons -1 -1) -1) + :color "grey25" + :style nil)) + (((class color) (background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :box ( :line-width ,(if (>= emacs-major-version 28) (cons -1 -1) -1) + :color "grey75" + :style nil))) + "Face uses instead of `hl-line' in Forge's `tabulated-list-mode' buffers. +It is recommended that you stick to using a box for this purpose, +as using the background color would shadow the background colors +used for labels." + :group 'forge-faces) + +(defface forge-tablist-topic-label + `((t :inherit forge-topic-label)) + "Face used for topic labels in Forge's `tabulated-list-mode' buffers. +This face can be used to control whether a box is added to labels +and how that is styled. The background colors used for any given +label, cannot be changed independently of the color used in the +forges web interface." + :group 'forge-faces) + +;;; Mode + +(defvar-keymap forge-topic-list-mode-map + :doc "Local keymap for Forge-Topic-List mode buffers." + :parent tabulated-list-mode-map + "RET" #'forge-visit-this-topic + "" #'forge-visit-this-topic + "o" #'forge-browse-this-topic + "C-c C-m" #'forge-topics-menu + "'" #'forge-dispatch + "?" #'magit-dispatch) + +(defvar forge-topic-list-mode-name + '((:eval (capitalize + (concat (if forge--buffer-list-filter + (format "%s " forge--buffer-list-filter) + "") + (if forge--buffer-list-type + (format "%ss" forge--buffer-list-type) + "topics"))))) + "Information shown in the mode-line for `forge-topic-list-mode'. +Must be set before `forge-list' is loaded.") + +(define-derived-mode forge-topic-list-mode tabulated-list-mode + forge-topic-list-mode-name + "Major mode for browsing a list of topics." + (setq-local hl-line-face 'forge-tablist-hl-line) + (setq-local x-stretch-cursor nil) + (setq tabulated-list-padding 0) + (setq tabulated-list-sort-key (cons "#" nil))) + +(defun forge-topic-get-buffer (&optional repo create) + (let ((name (if repo + (format "*forge-topics: %s*" (oref repo slug)) + "*forge-topics*"))) + (if create + (get-buffer-create name) + (get-buffer name)))) + +(defun forge-topic-list-setup (type filter fn &optional repo global columns) + (let* ((repo (or repo + (and (not global) + (if-let* ((topic (forge-topic-at-point)) + (repo (forge-get-repository topic))) + repo + (forge-get-repository :tracked?))))) + (dir (or (and repo (forge-get-worktree repo)) "/")) + (buffer nil)) + (unless (or repo global) + (error "Cannot determine repository")) + (with-current-buffer (setq buffer (forge-topic-get-buffer repo t)) + (setq default-directory dir) + (setq forge-buffer-repository (and repo (oref repo id))) + (setq forge--tabulated-list-columns (or columns forge-topic-list-columns)) + (setq forge--tabulated-list-query + (cond ((not (functionp fn)) + (lambda () + (cl-sort (mapcan (-cut funcall <> repo) fn) + #'> :key (-cut oref <> number)))) + (repo (apply-partially fn repo)) + (fn))) + (cl-letf (((symbol-function #'tabulated-list-revert) #'ignore)) ; see #229 + (forge-topic-list-mode)) + (setq forge--buffer-list-type type) + (setq forge--buffer-list-filter filter) + (setq forge--buffer-list-global global) + (forge--tablist-refresh) + (add-hook 'tabulated-list-revert-hook #'forge--tablist-refresh nil t) + (tabulated-list-print) + (when hl-line-mode + (hl-line-highlight))) + (switch-to-buffer buffer))) + +;;; Commands +;;;; Menu + +;;;###autoload (autoload 'forge-topics-menu "forge-topics" nil t) +(transient-define-prefix forge-topics-menu () + "Control list of topics and the topic at point." + :transient-suffix t + :transient-non-suffix t + :transient-switch-frame nil + :refresh-suffixes t + :column-widths forge--topic-menus-column-widths + [:hide always + ("q" forge-menu-quit-list) + ("RET" forge-topic-menu) + ("" forge-topic-menu)] + [["Type" + (:info "topics" :face forge-suffix-active) + ("n" "notifications..." forge-notifications-menu :transient replace) + ("r" "repositories..." forge-repositories-menu :transient replace)] + [:description (lambda () + (if forge--buffer-list-global + "Per-repository lists" + "Subtype")) + ("t" "topics" forge-list-topics) + ("i" "issues" forge-list-issues) + ("p" "pull-requests" forge-list-pullreqs) + ""] + ["Filter" + :if (lambda () (and (not forge--buffer-list-global) + (eq forge--buffer-list-type 'topic))) + ("l" "labeled" forge-list-labeled-topics) + ("c" "created" forge-list-authored-topics) + ("a" "assigned" forge-list-assigned-topics)] + ["Filter" + :if (lambda () (and (not forge--buffer-list-global) + (eq forge--buffer-list-type 'issue))) + ("l" "labeled" forge-list-labeled-issues) + ("c" "created" forge-list-authored-issues) + ("a" "assigned" forge-list-assigned-issues)] + ["Filter" + :if (lambda () (and (not forge--buffer-list-global) + (eq forge--buffer-list-type 'pullreq))) + ("l" "labeled" forge-list-labeled-pullreqs) + ("c" "created" forge-list-authored-pullreqs) + ("a" "assigned" forge-list-assigned-pullreqs) + ("w" "awaiting review" forge-list-requested-reviews)]] + [forge--topic-set-state-group + ["Global lists" + ("o t" "owned topics" forge-list-owned-topics) + ("o i" "owned issues" forge-list-owned-issues) + ("o p" "owned pull-requests" forge-list-owned-pullreqs)] + ["Actions" + ("f" "fetch all topics" forge-pull) + ("m" "show more actions" forge-dispatch)]] + [forge--topic-set-status-group] + (interactive) + (catch 'add-instead + (unless (derived-mode-p 'forge-topic-list-mode) + (let ((repo (forge-current-repository))) + (cond + ((or (not repo) + (forge-get-repository repo nil :tracked?))) + ((y-or-n-p (format "Add %s to database, so its topics can be listed?" + (oref repo slug))) + (forge-add-repository (forge-get-url repo)) + (throw 'add-instead t)) + ((setq repo nil))) + (if-let ((buffer (forge-topic-get-buffer repo))) + (switch-to-buffer buffer) + (if repo + (forge-list-topics repo) + (forge-list-owned-topics))))) + (transient-setup 'forge-topics-menu))) + +(defun forge-menu-quit-list () + "From a transient menu, quit the list buffer and the menu. + +If quitting the list buffer causes another topic, repository or +notification list buffer to become current in the selected window, +then display the respective menu, otherwise display no menu." + (interactive) + (when (derived-mode-p 'forge-topic-mode + 'forge-topic-list-mode + 'forge-repository-list-mode + 'forge-notifications-mode) + (quit-window)) + (cond ((derived-mode-p 'forge-topic-mode) + (setq transient--exitp 'replace) + (transient-setup (setq this-command 'forge-topic-menu))) + ((derived-mode-p 'forge-topic-list-mode) + (setq transient--exitp 'replace) + (transient-setup (setq this-command 'forge-topics-menu))) + ((derived-mode-p 'forge-repository-list-mode) + (setq transient--exitp 'replace) + (transient-setup (setq this-command 'forge-repositories-menu))) + ((derived-mode-p 'forge-notifications-mode) + (setq transient--exitp 'replace) + (transient-setup (setq this-command 'forge-notifications-menu))) + (t + (setq transient--exitp t) + (transient--pre-exit) + (transient--stack-zap)))) + +;;;; Suffix Class + +(defclass forge--topic-list-command (transient-suffix) + ((type :initarg :type :initform nil) + (filter :initarg :filter :initform nil) + (global :initarg :global :initform nil) + (inapt-if :initform 'forge--topic-list-inapt) + (inapt-face :initform nil))) + +(defun forge--topic-list-inapt () + (with-slots (type filter global) transient--pending-suffix + (and (eq type forge--buffer-list-type) + (eq filter forge--buffer-list-filter) + (eq global forge--buffer-list-global)))) + +(cl-defmethod transient-format-description ((obj forge--topic-list-command)) + (with-slots (description type filter global) obj + (if (and (eq type forge--buffer-list-type) + (memq filter (list nil forge--buffer-list-filter)) + (eq global forge--buffer-list-global)) + (propertize description 'face 'forge-suffix-active) + description))) + +;;;; Topic + +(defun forge--topic-list-setup (filter fn &optional repo global columns) + (forge-topic-list-setup 'topic filter fn repo global columns)) + +;;;###autoload (autoload 'forge-list-topics "forge-topics" nil t) +(transient-define-suffix forge-list-topics (&optional repository) + "List topics of the current repository. +Non-interactively if optional REPOSITORY is non-nil, then list +topics for that instead." + :class 'forge--topic-list-command :type 'topic + (interactive) + (forge--topic-list-setup nil + (list #'forge--ls-issues + #'forge--ls-pullreqs) + repository)) +(put 'forge-list-topics 'interactive-only nil) + +;;;###autoload (autoload 'forge-list-labeled-topics "forge-topics" nil t) +(transient-define-suffix forge-list-labeled-topics (label) + "List topics of the current repository that have LABEL." + :class 'forge--topic-list-command :type 'topic :filter 'labeled + (interactive (list (forge-read-topic-label))) + (forge--topic-list-setup 'labeled + (list (-cut forge--ls-labeled-issues <> label) + (-cut forge--ls-labeled-pullreqs <> label)))) + +;;;###autoload (autoload 'forge-list-assigned-topics "forge-topics" nil t) +(transient-define-suffix forge-list-assigned-topics () + "List topics of the current repository that are assigned to you." + :class 'forge--topic-list-command :type 'topic :filter 'assigned + (interactive) + (forge--topic-list-setup 'assigned + (list #'forge--ls-assigned-issues + #'forge--ls-assigned-pullreqs))) + +;;;###autoload (autoload 'forge-list-authored-topics "forge-topics" nil t) +(transient-define-suffix forge-list-authored-topics () + "List open topics from the current repository that are authored by you." + :class 'forge--topic-list-command :type 'topic :filter 'authored + (interactive) + (forge--topic-list-setup 'authored + (list #'forge--ls-authored-issues + #'forge--ls-authored-pullreqs))) + +;;;###autoload (autoload 'forge-list-owned-topics "forge-topics" nil t) +(transient-define-suffix forge-list-owned-topics () + "List open pull-requests from all your Github repositories. +Options `forge-owned-accounts' and `forge-owned-ignored' +controls which repositories are considered to be owned by you. +Only Github is supported for now." + :class 'forge--topic-list-command :type 'topic :filter 'owned :global t + (interactive) + (forge--topic-list-setup 'owned + (list (lambda (_) (forge--ls-owned-issues)) + (lambda (_) (forge--ls-owned-pullreqs))) + nil t forge-global-topic-list-columns)) +(put 'forge-list-owned-topics 'interactive-only nil) + +;;;; Issue + +(defun forge--issue-list-setup (filter fn &optional repo global columns) + (forge-topic-list-setup 'issue filter fn repo global columns)) + +;;;###autoload (autoload 'forge-list-issues "forge-topics" nil t) +(transient-define-suffix forge-list-issues () + "List issues of the current repository." + :class 'forge--topic-list-command :type 'issue + (interactive) + (forge--issue-list-setup nil #'forge--ls-issues)) + +;;;###autoload (autoload 'forge-list-labeled-issues "forge-topics" nil t) +(transient-define-suffix forge-list-labeled-issues (label) + "List issues of the current repository that have LABEL." + :class 'forge--topic-list-command :type 'issue :filter 'labeled + (interactive (list (forge-read-topic-label))) + (forge--issue-list-setup 'labeled (-cut forge--ls-labeled-issues <> label))) + +;;;###autoload (autoload 'forge-list-assigned-issues "forge-topics" nil t) +(transient-define-suffix forge-list-assigned-issues () + "List issues of the current repository that are assigned to you." + :class 'forge--topic-list-command :type 'issue :filter 'assigned + (interactive) + (forge--issue-list-setup 'assigned #'forge--ls-assigned-issues)) + +;;;###autoload (autoload 'forge-list-authored-issues "forge-topics" nil t) +(transient-define-suffix forge-list-authored-issues () + "List open issues from the current repository that are authored by you." + :class 'forge--topic-list-command :type 'issue :filter 'authored + (interactive) + (forge--issue-list-setup 'authored #'forge--ls-authored-issues)) + +;;;###autoload (autoload 'forge-list-owned-issues "forge-topics" nil t) +(transient-define-suffix forge-list-owned-issues () + "List open issues from all your Github repositories. +Options `forge-owned-accounts' and `forge-owned-ignored' +controls which repositories are considered to be owned by you. +Only Github is supported for now." + :class 'forge--topic-list-command :type 'issue :filter 'owned :global t + (interactive) + (forge--issue-list-setup 'owned #'forge--ls-owned-issues + nil t forge-global-topic-list-columns)) + +;;;; Pullreq + +(defun forge--pullreq-list-setup (filter fn &optional repo global columns) + (forge-topic-list-setup 'pullreq filter fn repo global columns)) + +;;;###autoload (autoload 'forge-list-pullreqs "forge-topics" nil t) +(transient-define-suffix forge-list-pullreqs () + "List pull-requests of the current repository." + :class 'forge--topic-list-command :type 'pullreq + (interactive) + (forge--pullreq-list-setup nil #'forge--ls-pullreqs)) + +;;;###autoload (autoload 'forge-list-labeled-pullreqs "forge-topics" nil t) +(transient-define-suffix forge-list-labeled-pullreqs (label) + "List pull-requests of the current repository that have LABEL." + :class 'forge--topic-list-command :type 'pullreq :filter 'labeled + (interactive (list (forge-read-topic-label))) + (forge--pullreq-list-setup 'labeled (-cut forge--ls-labeled-pullreqs <> label))) + +;;;###autoload (autoload 'forge-list-assigned-pullreqs "forge-topics" nil t) +(transient-define-suffix forge-list-assigned-pullreqs () + "List pull-requests of the current repository that are assigned to you." + :class 'forge--topic-list-command :type 'pullreq :filter 'assigned + (interactive) + (forge--pullreq-list-setup 'assigned #'forge--ls-assigned-pullreqs)) + +;;;###autoload (autoload 'forge-list-requested-reviews "forge-topics" nil t) +(transient-define-suffix forge-list-requested-reviews () + "List pull-requests of the current repository that are awaiting your review." + :class 'forge--topic-list-command :type 'pullreq :filter 'review + (interactive) + (forge--pullreq-list-setup 'review #'forge--ls-requested-reviews)) + +;;;###autoload (autoload 'forge-list-authored-pullreqs "forge-topics" nil t) +(transient-define-suffix forge-list-authored-pullreqs () + "List open pull-requests from the current repository that are authored by you." + :class 'forge--topic-list-command :type 'pullreq :filter 'authored + (interactive) + (forge--pullreq-list-setup 'authored #'forge--ls-authored-pullreqs)) + +;;;###autoload (autoload 'forge-list-owned-pullreqs "forge-topics" nil t) +(transient-define-suffix forge-list-owned-pullreqs () + "List open pull-requests from all your Github repositories. +Options `forge-owned-accounts' and `forge-owned-ignored' +controls which repositories are considered to be owned by you. +Only Github is supported for now." + :class 'forge--topic-list-command :type 'pullreq :filter 'owned :global t + (interactive) + (forge--pullreq-list-setup 'owned #'forge--ls-owned-pullreqs + nil t forge-global-topic-list-columns)) + +;;; _ +(provide 'forge-topics) +;;; forge-topics.el ends here diff --git a/elpa/forge-20240523.1103/forge.el b/elpa/forge-20240523.1103/forge.el new file mode 100644 index 00000000..5a4f93b3 --- /dev/null +++ b/elpa/forge-20240523.1103/forge.el @@ -0,0 +1,169 @@ +;;; forge.el --- Access Git forges from Magit -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2024 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli +;; Homepage: https://github.com/magit/forge +;; Keywords: git tools vc + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . + +;;; Commentary: + +;; Work with Git forges, such as Github and Gitlab, from the comfort +;; of Magit and the rest of Emacs. + +;; The schema of the database has not been finalized yet. Until that +;; has happened it will occasionally have to be discarded. For now +;; the database does not contain any information that cannot simply +;; be fetched again. + +;;; Code: + +(require 'magit) + +(require 'forge-db) +(require 'forge-core) + +(provide 'forge) + +(require 'forge-repo) +(require 'forge-post) +(require 'forge-topic) +(require 'forge-issue) +(require 'forge-pullreq) +(require 'forge-revnote) +(require 'forge-notify) + +(require 'forge-github) +(require 'forge-gitlab) +(require 'forge-gitea) +(require 'forge-gogs) +(require 'forge-bitbucket) +(require 'forge-semi) + +(require 'forge-commands) +(require 'forge-topics) +(require 'forge-repos) + +;;; Add Sections + +(defvar forge-add-default-sections t + "Whether to add Forge's sections to `magit-status-sections-hook'. + +If you want to disable this, then you must set this to nil before +`forge' is loaded. + +If this is nil, then `forge-toggle-display-in-status-buffer' can +no longer do its job. It might be better to set the global value +of `forge-display-in-status-buffer' to nil instead. That way you +can still display topics on demand in the status buffer.") + +(when forge-add-default-sections + (magit-add-section-hook 'magit-status-sections-hook #'forge-insert-pullreqs nil t) + (magit-add-section-hook 'magit-status-sections-hook #'forge-insert-issues nil t)) + +;;; Add Bindings + +;;;###autoload +(defvar forge-add-default-bindings t + "Whether to add Forge's bindings to various Magit keymaps. + +If you want to disable this, then you must set this to nil before +`magit' is loaded. If you do it before `forge' but after `magit' +is loaded, then `magit-mode-map' ends up being modified anyway.") + +;;;###autoload +(with-eval-after-load 'magit-mode + (when forge-add-default-bindings + (keymap-set magit-mode-map "'" #'forge-dispatch) + (keymap-set magit-mode-map "N" #'forge-dispatch) + (keymap-set magit-mode-map " " + #'forge-browse) + (keymap-set magit-mode-map " " + #'forge-copy-url-at-point-as-kill))) + +;;;###autoload +(with-eval-after-load 'git-commit + (when forge-add-default-bindings + (keymap-set git-commit-mode-map "C-c C-v" #'forge-visit-topic))) + +(when forge-add-default-bindings + (keymap-set magit-commit-section-map "C-c C-v" #'forge-visit-topic) + (keymap-set magit-branch-section-map "C-c C-v" #'forge-visit-topic) + + (transient-insert-suffix 'magit-dispatch "o" + '("N" "Forge" forge-dispatch)) + + (transient-append-suffix 'magit-fetch "m" + '("n" "forge topics" forge-pull)) + (transient-append-suffix 'magit-fetch "n" + '("N" "forge notifications" forge-pull-notifications)) + + (transient-append-suffix 'magit-pull "m" + '("n" "forge topics" forge-pull)) + (transient-append-suffix 'magit-pull "n" + '("N" "forge notifications" forge-pull-notifications)) + + (transient-append-suffix 'magit-branch "w" + '("f" "pull-request" forge-checkout-pullreq)) + (transient-append-suffix 'magit-branch "W" + '("F" "from pull-request" forge-branch-pullreq)) + + (transient-suffix-put 'magit-remote 'magit-update-default-branch :key "b u") + (transient-append-suffix 'magit-remote "b u" + '("b r" "Rename default branch" forge-rename-default-branch)) + + (transient-append-suffix 'magit-worktree "c" + '("n" "pull-request worktree" forge-checkout-worktree)) + + (transient-append-suffix 'magit-status-jump "w" + '("Np" "Pull requests" forge-jump-to-pullreqs)) + (transient-append-suffix 'magit-status-jump "Np" + '("Ni" "Issues" forge-jump-to-issues)) + + (transient-append-suffix 'magit-merge "a" + '(7 "M" "Merge using API" forge-merge))) + +;;; Startup Asserts + +(defconst forge--minimal-git "2.7.0") + +(defun forge-startup-asserts () + (let ((version (magit-git-version))) + (when (and version (version< version forge--minimal-git)) + (display-warning 'magit (format "\ +Forge requires Git >= %s, you are using %s. + +If this comes as a surprise to you, because you do actually have +a newer version installed, then that probably means that the +older version happens to appear earlier on the `$PATH'. If you +always start Emacs from a shell, then that can be fixed in the +shell's init file. If you start Emacs by clicking on an icon, +or using some sort of application launcher, then you probably +have to adjust the environment as seen by graphical interface. +For X11 something like ~/.xinitrc should work. + +If you use Tramp to work inside remote Git repositories, then you +have to make sure a suitable Git is used on the remote machines +too.\n" forge--minimal-git version) :error)))) + +(if after-init-time + (forge-startup-asserts) + (add-hook 'after-init-hook #'forge-startup-asserts t)) + +;;; forge.el ends here diff --git a/elpa/forge-20240523.1103/forge.info b/elpa/forge-20240523.1103/forge.info new file mode 100644 index 00000000..bd873922 --- /dev/null +++ b/elpa/forge-20240523.1103/forge.info @@ -0,0 +1,1537 @@ +This is forge.info, produced by makeinfo version 6.7 from forge.texi. + + Copyright (C) 2018-2024 Jonas Bernoulli + + + 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 + + +File: forge.info, Node: Top, Next: Introduction, Up: (dir) + +Forge User and Developer Manual +******************************* + +Forge allows you to work with Git forges, such as Github and Gitlab, +from the comfort of Magit and the rest of Emacs. + +This manual is for Forge version 0.3.2.50-git. + + Copyright (C) 2018-2024 Jonas Bernoulli + + + You can redistribute this document and/or modify it under the terms + of the GNU General Public License as published by the Free Software + Foundation, either version 3 of the License, or (at your option) + any later version. + + This document is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + General Public License for more details. + +* Menu: + +* Introduction:: +* Supported Forges and Hosts:: +* Getting Started:: +* Usage:: +* FAQ:: +* Keystroke Index:: +* Function and Command Index:: +* Variable Index:: + +— The Detailed Node Listing — + +Supported Forges and Hosts + +* Supported Forges:: +* Partially Supported Forges:: +* Supported Semi-Forges:: + +Getting Started + +* Loading Forge:: +* Token Creation:: +* Initial Pull:: +* Repository Detection:: +* Caveats:: + +Usage + +* Pulling:: +* Branching:: +* Working with Topics:: +* Miscellaneous:: + +Working with Topics + +* Visiting Topics:: +* Listing Topics and Notifications:: +* Creating Topics:: +* Editing Topics and Posts:: + + +FAQ + +* Is it possible to create a single pull-request without pulling everything?:: +* ‘error in process filter HTTP Error 502, "Bad gateway"’: error in process filter HTTP Error 502 "Bad gateway". + + + +File: forge.info, Node: Introduction, Next: Supported Forges and Hosts, Prev: Top, Up: Top + +1 Introduction +************** + +Forge allows you to work with Git forges, such as Github and Gitlab, +from the comfort of Magit and the rest of Emacs. + + Forge fetches issues, pull-requests and other data using the forge’s +API and stores that in a local database. Additionally it fetches the +pull-request references using Git. Forge implements various features +that use this data but the database and pull-request refs can also be +used by third-party packages. + + +File: forge.info, Node: Supported Forges and Hosts, Next: Getting Started, Prev: Introduction, Up: Top + +2 Supported Forges and Hosts +**************************** + +Currently Forge supports two forges and three more forges partially. +Additionally it supports four semi-forges. Support for more forges and +semi-forges can and will be added. + + Both forges and semi-forges provide web interfaces for Git +repositories. Forges additionally support pull-requests and issues and +make those and other information available using an API. + + When a forge is only partially supported, then that means that only +the functionality that does not require the API is implemented, or in +other words, that the forge is only supported as a semi-forge. + + A host is a particular instance of a forge. For example the hosts + and are both instances +of the Gitlab forge. Forge supports some well known hosts out of the +box and additional hosts can easily be supported by adding entries to +the option ‘forge-alist’ (see *note Repository Detection::). + + For more details about the caveats mentioned below (and some others) +also see *note Getting Started::. + +* Menu: + +* Supported Forges:: +* Partially Supported Forges:: +* Supported Semi-Forges:: + + +File: forge.info, Node: Supported Forges, Next: Partially Supported Forges, Up: Supported Forges and Hosts + +2.1 Supported Forges +==================== + +Github +------ + +Forge’s support for Github can be considered the "reference +implementation". Support for other forges can lag behind a bit. + +Github Caveats +.............. + + • Forge uses the Github GraphQL API when possible but has to fall + back to use the REST API in many cases because the former is still + rather incomplete. + + • The Github GraphQL API has a hard-coded timeout on queries. The + only solution is to reduce the number of entities we query at once, + which can be done by adjusting either the ‘forge.graphqlItemLimit’ + git variable or the field "GQL entity limit" in a status buffer. + + • Forge depends on the ‘updated_at’ field being updated when + appropriate. For Github pull-requests at least, that is not always + done. + +Github Hosts +............ + + • + +Gitlab +------ + +Gitlab Caveats +.............. + + • Forge cannot provide notifications because the Gitlab API does not + expose those. + +Gitlab Hosts +............ + + • + • + • + + +File: forge.info, Node: Partially Supported Forges, Next: Supported Semi-Forges, Prev: Supported Forges, Up: Supported Forges and Hosts + +2.2 Partially Supported Forges +============================== + +Gitea https://gitea.io +---------------------- + +This is the next forge whose API will be supported. + +Gitea Hosts +........... + + • + +Gogs https://gogs.io +-------------------- + +Once Gitea is supported it should be fairly simple to support Gogs too, +because the former is a fork of the latter and the APIs seem to still be +very similar. + +Gogs Hosts +.......... + + • + +Bitbucket https://bitbucket.org +------------------------------- + +I don’t plan to support Bitbucket’s API any time soon, and it gets less +likely that I will every do it every time I look at it. + +Bitbucket Caveats +................. + + • The API documentation is poor and initial tests indicated that the + implementation is buggy. + + • Atlassian’s offering contains two very distinct implementations + that are both called "Bitbucket". Forge only supports the + implementation whose only instance is available at + , 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: . + +Bitbucket Hosts +............... + + • + + +File: forge.info, Node: Supported Semi-Forges, Prev: Partially Supported Forges, Up: Supported Forges and Hosts + +2.3 Supported Semi-Forges +========================= + +Gitweb https://git-scm.com/docs/gitweb +-------------------------------------- + +Gitweb Caveats +.............. + + • I could find only one public installation + (), which gives users the choice + between Gitweb and Cgit. The latter seems more popular (not just + on this site). + +Cgit https://git.zx2c4.com/cgit/about +------------------------------------- + +Cgit Caveats +............ + + • Different sites use different URL schemata and some of the bigger + sites use a fork. For this reason Forge has to provide several + classes to support different variations of Cgit and you have to + look at their definitions to figure out which one is the correct + one for a particular installation. + +Cgit Hosts +.......... + + • + • + • + +Stgit https://codemadness.org/git/stagit/file/README.html +--------------------------------------------------------- + +Stgit Caveats +............. + + • Stgit cannot show logs for branches beside "master". For that + reason Forge takes users to a page listing the branches when they + request the log for a particular branch (even for "master" whose + log is just one click away from there). + +Stgit Hosts +........... + + • + +Srht https://meta.sr.ht +----------------------- + +Srht Caveats +............ + + • Srht cannot show logs for branches beside "master". For that + reason Forge takes users to a page listing the branches when they + request the log for a particular branch (even for "master" whose + log is just one click away from there). + +Srht Hosts +.......... + + • + + +File: forge.info, Node: Getting Started, Next: Usage, Prev: Supported Forges and Hosts, Up: Top + +3 Getting Started +***************** + +Initial setup turned out to more challenging for many users than I had +hoped. I am trying to counter that by providing detailed instructions +that cover not just the happy path but also many of the issues users +have ran into in the past. The recommended reading is longer than one +might wish, but skipping it does not necessarily save time. + + Forge uses the Ghub package to access the APIs of supported forges. +How this works and how to create and store a token is documented in +*note (ghub)Getting Started::. Please read that in full before coming +back here and continuing with the subsections listed below. + + lists additional resources; +including a link to a much shorter quick-start guide provided by a user. + +* Menu: + +* Loading Forge:: +* Token Creation:: +* Initial Pull:: +* Repository Detection:: +* Caveats:: + + +File: forge.info, Node: Loading Forge, Next: Token Creation, Up: Getting Started + +3.1 Loading Forge +================= + +Loading Magit doesn’t cause Forge to be loaded automatically. Adding +something like this to your init file takes care of that: + + (with-eval-after-load 'magit + (require 'forge)) + +Or if you use ‘use-package’: + + (use-package forge + :after magit) + + +File: forge.info, Node: Token Creation, Next: Initial Pull, Prev: Loading Forge, Up: Getting Started + +3.2 Token Creation +================== + +Forge uses the Ghub package to access the APIs of supported Git forges. +How this works and how to create and store a token is documented in +*note (ghub)Getting Started::. + + Ghub used to provide a setup wizard, but that had to be removed for +reasons given in the manual just mentioned. Nowadays there is no way +around reading the documentation and doing this manually I am afraid. + + Forge requires the following token scopes. + + • For Github these scopes are required. + + • ‘repo’ grants full read/write access to private and public + repositories. + • ‘user’ grants access to profile information. + • ‘read:org’ grants read-only access to organization membership. + + More information about these and other scopes can be found at + . + + • For Gitlab instances ‘api’ is the only required scope. It gives + read and write access to everything. The Gitlab API provides more + fine-grained scopes for read-only access, but when any write access + at all is required, then it is all or nothing. + + +File: forge.info, Node: Initial Pull, Next: Repository Detection, Prev: Token Creation, Up: Getting Started + +3.3 Initial Pull +================ + +To start using Forge in a certain repository visit the Magit status +buffer for that repository and type ‘f n’ (‘forge-pull’). +Alternatively, you can use ‘M-x forge-add-repository’, which makes it +possible to add a forge repository without pulling all topics and even +without having to clone the respective Git repository. + + You must set up a token *before* you can add the first repository. +See *note Token Creation::. + + The first time ‘forge-pull’ is run in a repository, an entry for that +repository is added to the database and a new value is added to the Git +variable ‘remote..fetch’, which fetches all pull-requests. +(‘+refs/pull/*/head:refs/pullreqs/*’ for Github) + + ‘forge-pull’ then fetches topics and other information using the +forge’s API and pull-request references using Git. + + The initial fetch can take a while but most of that is done +asynchronously. Storing the information in the database is done +synchronously though, so there can be a noticeable hang at the end. +Subsequent fetches are much faster. + + Fetching issues from Github is much faster than fetching from other +forges because making a handful of GraphQL requests is much faster than +making hundreds of REST requests. + + +File: forge.info, Node: Repository Detection, Next: Caveats, Prev: Initial Pull, Up: Getting Started + +3.4 Repository Detection +======================== + +Ghub does *not* associate a given local repository with a repository on +a forge. The Forge package itself takes care of this. In doing so it +ignores the Git variable ‘ghub.host’ and other ‘*.host’ variables used +by Ghub. (But ‘github.user’ and other variables used to specify the +user are honored). + + Forge associates the local repository with a forge repository by +first determining which remote is associated with the upstream +repository and then looking that up in ‘forge-alist’. + + If only one remote exists, then Forge uses that unconditionally. To +reduce the number of support requests, this is even the case if the Git +variable ‘forge.remote’ names another, non-existent, remote. + + If several remotes exist, then a remote may be selected based on its +name. Almost always we want to fetch the data associated with the +upstream repository, so that is what the logic described here tries to +achieve. The convention is to name the upstream remote "origin", and if +that convention were universally followed, then things would be trivial. +However many people name the upstream remote "upstream", which also +makes sense. + + Note, however, that even though a surprising number of people do + just that, it does not make any sense to use the name "origin" to + refer to a fork; not even to your own fork. A fork is a *copy* of + the original, "copy" is an antonym for "original", and the word + "origin" is not only closely related to but even contained in the + word "original". Naming a fork the "origin" is at best extremely + confusing. + + copy + a thing made to be similar or identical to another. + + original + the earliest form of something, from which copies may be made. + + origin + the point or place where something begins, arises, or is + derived. + + If several remotes exist, then the following remote names are tried +in order and the first remote thus named that exists in the repository +is used. + + 1. The value of the Git variable ‘forge.remote’, if set. If the + variable has a value but no remote by the specified name exists, + then a warning is shown, but otherwise this conflict is ignored. + This behavior is arguably odd, but due to historic and pragmatic + reasons it is the least painful path forward. + + 2. The remote named ‘upstream’, if it exists. + + 3. The remote named ‘origin’, if it exists. + + The remote named "upstream" is preferred over the remote named +"origin" because the existence of the former strongly suggests that the +latter is either not used in this repository (in which case the order +does not matter) or else it is abused as the name of a fork (in which +case "upstream" must be preferred). + + -- Variable: forge.remote + The value of this variable specifies the remote from which Forge + fetches data. It is usually best to leave this unspecified and to + rely on the behavior described above. + + If the remote has to be specified explicitly, then this should be + done locally, for a single repository. + + Only ever set this globally, if you consistently use a certain name + to refer to the upstream repository and it isn’t one of "upstream" + or "origin", and you *never* use that name to refer to a repository + that does *not* refer to the upstream repository. + +‘N r’ (‘forge-forge.remote’) + This command changes the value of the ‘forge.remote’ Git variable + in the current repository. + + If this variable is set, then Forge uses the remote by that name, if +it exists, the same way it may have used ‘origin’ if the the variable +were undefined. I.e., it does not fall through to try ‘origin’ if no +remote by your chosen name exists. + + Once the upstream remote has been determined, Forge looks it up in +‘forge-alist’, using the host part of the URL as the key. For example +the key for ‘git@github.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 "/v3" and whose GraphQL API’s end + point is "/graphql", then use "/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. + + +File: forge.info, Node: Caveats, Prev: Repository Detection, Up: Getting Started + +3.5 Caveats +=========== + + • Fetched information is stored in a database. The table schemata of + that database have not been finalized yet. Until that has happened + it will occasionally have to be discarded. That isn’t such a huge + deal because for now the database does not contain any information + that cannot simply be fetched again, see *note Initial Pull::. + + • Fetching is implemented under the assumption that the API can be + asked to list the things that have changed since we last checked. + Unfortunately the APIs are not bug-free, so this is not always the + case. If in doubt, then re-fetch an individual topic to ensure it + is up-to-date using the command ‘forge-pull-topic’. + + • Some other, forge-specific, caveats are mentioned in *note + Supported Forges and Hosts::. + + +File: forge.info, Node: Usage, Next: FAQ, Prev: Getting Started, Up: Top + +4 Usage +******* + +Once information has been pulled from a repository’s forge for the first +time, Forge adds two additional sections, named "Pull requests" and +"Issues" to Magit’s status buffer. It is also possible to add a +repository to the local database without pulling all the data, which is +useful if you want to create a single pull-request. + +‘N a’ (‘forge-add-repository’) + This command adds a repository to the database. + + It offers to either pull topics (now and in the future) or to only + pull individual topics when the user invokes ‘forge-pull-topic’. + + Some of Forge’s commands are only bound when point is within one of +these sections but other commands are also available elsewhere in +Magit’s status buffer and/or from Magit’s transient commands. + +‘N’ (‘forge-dispatch’) + This prefix command is available in any Magit buffer and provides + access to several of the available Forge commands. Most of these + commands are also bound elsewhere, but some are not. See the + following sections for information about the available commands. + + Throughout this manual you will find many bindings that begin with + ‘N’, but if you prefer to continue to use ‘forge-dispatch’’s older + binding you can substitute ‘'’ for that. + +* Menu: + +* Pulling:: +* Branching:: +* Working with Topics:: +* Miscellaneous:: + + +File: forge.info, Node: Pulling, Next: Branching, Up: Usage + +4.1 Pulling +=========== + +The commands that fetch forge data are available from the same transient +prefix command (‘magit-fetch’ on ‘f’) that is used to fetch Git data. +If option ‘magit-pull-or-fetch’ is non-nil, then they are also available +from the ‘magit-pull’ transient (on ‘F’). + +‘f n’ (‘forge-pull’) +‘N f f’ + This command uses a forge’s API to fetch topics and other + information about the current repository and stores the fetched + information in the database. It also fetches notifications for all + repositories from the same forge host. (Currently this is limited + to Github.) Finally it fetches pull-request references using Git. + + After using this command for the first time in a given repository + the status buffer for that repository always lists the + pull-requests and issues. See *note Initial Pull::. + +‘f N’ (‘forge-pull-notifications’) +‘N f n’ + This command uses a forge’s API to fetch all notifications from + that forge including, but not limited to, the notifications for the + current repository. + + Fetching all notifications fetches associated topics even if you + have not started fetching *all* topics for the respective + repositories (using ‘forge-pull’), but it does not cause the topics + to be listed in the status buffer of such "uninitialized" + repositories. + + Note how pulling data from a forge’s API works the same way as +pulling Git data does; you do it explicitly when you want to see the +work done by others. + + This is less disruptive, more reliable, and easier to understand than +if Forge did the pulling by itself at random intervals. It might +however mean that you occasionally invoke a command expecting the most +recent data to be available and then have to abort to pull first. The +same can happen with Git, e.g., you might attempt to merge a branch that +you know exists but haven’t actually pulled yet. + +‘N f t’ (‘forge-pull-topic’) + This command uses a forge’s API to fetch a single pull-request and + stores it in the database. + + Normally you wouldn’t want to pull a single pull-request by itself, + but due to a bug in the Github API you might sometimes have to do + so. + + Fetching is implemented under the assumption that the API can be + asked to list the things that have changed since we last checked. + Unfortunately the APIs are not bug-free, so this is not always the + case. If in doubt, then re-fetch an individual topic to ensure it + is up-to-date using the command ‘forge-pull-topic’. + + +File: forge.info, Node: Branching, Next: Working with Topics, Prev: Pulling, Up: Usage + +4.2 Branching +============= + +Forge provides commands for creating and checking out a new branch or +work tree from a pull-request. These commands are available from the +same transient prefix commands as the suffix commands used to create and +check out branches and work trees in a more generic fashion +(‘magit-branch’ on ‘b’ and ‘magit-worktree’ on ‘%’). + +‘b F’ (‘forge-branch-pullreq’) + This command creates and configures a new branch from a + pull-request, creating and configuring a new remote if necessary. + + The name of the local branch is the same as the name of the remote + branch that you are being asked to merge, unless the contributor + could not be bothered to properly name the branch before opening + the pull-request. The most likely such case is when you are being + asked to merge something like "fork/master" into "origin/master". + In such cases the local branch will be named "pr-N", where ‘N’ is + the pull-request number. + + These variables are always set by this command: + + • ‘branch..pullRequest’ is set to the pull-request number. + • ‘branch..pullRequestRemote’ is set to the remote on + which the pull-request branch is located. + • ‘branch..pushRemote’ is set to the same remote as + ‘branch..pullRequestRemote’ if that is possible, + otherwise it is set to the upstream remote. + • ‘branch..description’ is set to the pull-request title. + • ‘branch..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..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..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..pullRequestRemote’ is set to the + remote on which the pull-request branch is located. + +‘b f’ (‘forge-checkout-pullreq’) + This command creates and configures a new branch from a + pull-request the same way ‘forge-branch-pullreq’ does. + Additionally it checks out the new branch. + +‘Z n’ (‘forge-checkout-worktree’) + This command creates and configures a new branch from a + pull-request the same way ‘forge-branch-pullreq’ does. + Additionally it checks out the new branch using a new working tree. + + -- User Option: forge-checkout-worktree-read-directory-function + This function is used by ‘forge-checkout-worktree’ to read read the + new worktree directory where it checks out to pull-request. It + takes the pull-request as the only argument and must return a + directory. + + When you delete a pull-request branch, which was created using one of +the above three commands, then ‘magit-branch-delete’ usually offers to +also delete the corresponding remote. It does not offer to delete a +remote if (1) the remote is the upstream remote, and/or (2) if other +branches are being fetched from the remote. + + Note that you have to delete the local branch (e.g., "feature") for +this to work. If you delete the tracking branch (e.g., "fork/feature"), +then the remote is never removed. + + +File: forge.info, Node: Working with Topics, Next: Miscellaneous, Prev: Branching, Up: Usage + +4.3 Working with Topics +======================= + +We call both issues and pull-requests "topics". The contributions to +the conversation are called "posts". + +* Menu: + +* Visiting Topics:: +* Listing Topics and Notifications:: +* Creating Topics:: +* Editing Topics and Posts:: + + +File: forge.info, Node: Visiting Topics, Next: Listing Topics and Notifications, Up: Working with Topics + +4.3.1 Visiting Topics +--------------------- + +Magit’s status buffer contains lists of issues and pull-requests. +Topics are ordered by last modification time. All open issues and some +recently edited and closed topics are listed. + + Forge provides some commands that act on the listed topics. These +commands can also be used in other contexts, such as when point is on a +commit or branch section. + +‘C-c C-w’ (‘forge-browse-TYPE’) +‘C-c C-w’ (‘forge-browse-dwim’) +‘N b r’ (‘forge-browse-remote’) +‘N b I’ (‘forge-browse-issues’) +‘N b P’ (‘forge-browse-pullreqs’) +‘N b t’ (‘forge-browse-topic’) +‘N b i’ (‘forge-browse-issue’) +‘N b p’ (‘forge-browse-pullreq’) + These commands visit the topic, issue(s), pull-request(s), post, + branch, commit, or remote at point in a browser. + + This is implemented using various commands named + ‘forge-browse-TYPE’, and the key binding is defined by remapping + ‘magit-browse-thing’ (as defined in ‘magit-mode-map)’. For commit + sections this key is bound to ‘forge-browse-dwim’, which prefers a + topic over a branch and a branch over a commit. + +‘’ (‘forge-visit-TYPE’) +‘C-c C-v’ (‘forge-visit-topic’) +‘N v t’ (‘forge-visit-topic’) +‘N v i’ (‘forge-visit-issue’) +‘N v p’ (‘forge-visit-pullreq’) + These commands visit the pull-request(s), issue(s), or repository + in a separate buffer. + + The ‘RET’ binding is only available when point is on a issue or + pull-request section because that key is already bound to something + else for most of Magit’s own sections. ‘C-c C-v’ however is also + available on regular commit (e.g., in a log) and branch sections. + + This is implemented using various commands named ‘forge-visit-TYPE’ + and the key binding is defined by remapping ‘magit-visit-thing’ (as + defined in ‘magit-mode-map’). + + +File: forge.info, Node: Listing Topics and Notifications, Next: Creating Topics, Prev: Visiting Topics, Up: Working with Topics + +4.3.2 Listing Topics and Notifications +-------------------------------------- + +By default Forge lists a subset of topics directly in the Magit status +buffer. It also provides commands to list topics and notifications in +separate buffers. + + Forge adds the following functions to ‘magit-status-sections-hook’: + + -- Function: forge-insert-pullreqs + This function inserts a list of the most recent and/or open + pull-requests. + + -- Function: forge-insert-issues + This function inserts a list of the most recent and/or open issues. + + -- User Option: forge-topic-list-limit + This option limits the number of topics listed by the above + functions. + + All unread topics are always shown. If the value of this option + has the form ‘(OPEN . CLOSED)’, then the integer ‘OPEN’ specifies + the maximal number of topics and ‘CLOSED’ specifies the maximal + number of closed topics. IF ‘CLOSED’ is negative then show no + closed topics until the command ‘forge-toggle-closed-visibility’ + changes the sign. + + -- Command: forge-toggle-closed-visibility + This command toggles whether the above two functions list recently + closed issues in the current buffer. + + The following functions are also suitable for +‘magit-status-sections-hook’: + + -- Function: forge-insert-assigned-pullreqs + This function inserts a list of open pull-requests that are + assigned to you. + + -- Function: forge-insert-requested-reviews + This function inserts a list of open pull-requests that are + awaiting your review. + + -- Function: forge-insert-authored-pullreqs + This function inserts a list of open pull-requests that are + authored by you. + + -- Function: forge-insert-assigned-issues + This function inserts a list of open issues that are assigned to + you. + + -- Function: forge-insert-authored-issues + This function inserts a list of open issues that are authored by + you. + + The following commands list repositories, notifications and topics in +dedicated buffers: + +‘N l r’ (‘forge-list-repositories’) + This command lists all known repositories in a separate buffer. + +‘N l n’ (‘forge-list-notifications’) + This command lists all notifications for all forges in a separate + buffer. + +‘N l p’ (‘forge-list-pullreqs’) + This command lists the current repository’s pull-requests in a + separate buffer. + +‘N l i’ (‘forge-list-issues’) + This command lists the current repository’s issues in a separate + buffer. + + -- Command: forge-list-labeled-pullreqs + This command lists the current repository’s open pull-requests that + are labeled with a label read from the user. + + -- Command: forge-list-labeled-issues + This command lists the current repository’s open issues that are + labeled with a label read from the user. + + -- Command: forge-list-assigned-pullreqs + This command lists the current repository’s open pull-requests that + are assigned to you in a separate buffer. + + -- Command: forge-list-assigned-issues + This command lists the current repository’s open issues that are + assigned to you in a separate buffer. + + -- Command: forge-list-requested-reviews + This command lists pull-requests of the current repository that are + awaiting your review in a separate buffer. + + -- Command: forge-list-authored-pullreqs + This command lists the current repository’s open pull-requests that + are authored by you in a separate buffer. + + -- Command: forge-list-authored-issues + This command lists the current repository’s open issues that are + authored by you in a separate buffer. + + -- Command: forge-list-owned-pullreqs + This command lists open pull-requests from all the repositories + that you own. Options ‘forge-owned-accounts’ and + ‘forge-owned-ignored’ controls which repositories are considered to + be owned by you. Only Github is supported for now. + + -- Command: forge-list-owned-issues + This command lists open issues from all the repositories that you + own. Options ‘forge-owned-accounts’ and ‘forge-owned-ignored’ + controls which repositories are considered to be owned by you. + Only Github is supported for now. + + -- User Option: forge-owned-accounts + This is an alist of accounts that are owned by you. This should + include your username as well as any organization that you own. + Used by the commands ‘forge-list-owned-issues’, + ‘forge-list-owned-pullreqs’ and ‘forge-fork’. + + Each element has the form ‘(ACCOUNT . PLIST)’. The following + properties are currently being used: + + • ‘remote-name’ The default name suggested by ‘forge-fork’ for a + fork created within this account. If unspecified, then the + name of the account is used. + + Example: ‘(("tarsius") ("emacsmirror" remote-name "mirror"))’. + + -- User Option: forge-owned-ignored + This is a list of repository names that are considered to not be + owned by you even though they would have been considered to be + owned by you based on ‘forge-owned-accounts’. + + +File: forge.info, Node: Creating Topics, Next: Editing Topics and Posts, Prev: Listing Topics and Notifications, Up: Working with Topics + +4.3.3 Creating Topics +--------------------- + +‘N c p’ (‘forge-create-pullreq’) +‘C-c C-n [on "Pull requests" section]’ + This command creates a new pull-request for the current repository. + +‘N c i’ (‘forge-create-issue’) +‘C-c C-n [on "Issues" section]’ + This command creates a new issue for the current repository. + + +File: forge.info, Node: Editing Topics and Posts, Prev: Creating Topics, Up: Working with Topics + +4.3.4 Editing Topics and Posts +------------------------------ + +We call both issues and pull-requests "topics". The contributions to +the conversation are called "posts". The post that initiated the +conversation is also called a post. + + These commands are available only from the topic buffer (i.e., from +the buffer that shows the posts on a topic). Other commands that also +work in other buffers are available here also. For example ‘C-c C-w’ on +a post visits that post in a browser. + +‘C-c C-n’ (‘forge-create-post’) +‘C-c C-r’ + This command allows users to create a new post on an existing + topic. It opens a buffer in which the user can write the post. + When the post is done, then the user has to submit using ‘C-c C-c’. + + If the region is active and marks part of an existing post, then + that part of the post is quoted. Otherwise, or if a prefix + argument is used, then the complete post that point is currently on + is quoted. + +‘C-c C-e [on a post section]’ (‘forge-edit-post’) + This command visits an existing post in a separate buffer. When + the changes to the post are done, then the user has to submit using + ‘C-c C-c’. + +‘C-c C-e [on "Title" section]’ (‘forge-edit-topic-title’) + This command reads a new title for an existing topic in the + minibuffer. + +‘C-c C-e [on "State" section]’ (‘forge-edit-topic-state’) + This command toggles the state of an existing topic between "open" + and "closed". + +‘C-c C-e [on "Draft" section]’ (‘forge-edit-topic-draft’) + This command toggles whether an existing topic is a draft or not. + +‘C-c C-e [on "Labels" section]’ (‘forge-edit-topic-labels’) + This command reads a list of labels for an existing topic in the + minibuffer. + +‘C-c C-e [on "Marks" section]’ (‘forge-edit-topic-marks’) + This command reads a list of marks for an existing topic in the + minibuffer. + + Marks are like labels except that they are not shared with anyone + else. To create a mark that topics can subsequently be marked with + use the command ‘forge-create-mark’. Existing marks can be edited + using the command ‘forge-edit-mark’. + +‘C-c C-e [on "Assignees" section]’ (‘forge-edit-topic-assignees’) + This command reads a list of assignees for an existing topic in the + minibuffer. + +‘C-c C-e [on "Review-Requests" section]’ (‘forge-edit-topic-review-requests’) + This command reads a list of people who you would like to review an + existing topic in the minibuffer. + +‘C-c C-e [on "Note" section]’ +‘M-x forge-edit-topic-note’ + This lets you edit your private note about a topic. + +‘C-c C-k [on a comment section]’ (‘forge-delete-comment’) + This command deletes the comment at point. + +‘m M [if enabled]’ (‘forge-merge’) +‘N M [if enabled]’ + This command merges the current pull-request using the forge’s API. + If there is no current pull-request or with a prefix argument, then + it reads a pull-request to visit instead. + + The "merge method" to be used is read from the user. + + Use of this command is discouraged. Unless the remote repository + is configured to disallow that, you should instead merge locally + and then push the target branch. Forges detect that you have done + that and respond by automatically marking the pull-request as + merged. + + Creating a new post and editing an existing post are similar to +creating a new commit and editing the message of an existing commit. In +both cases the message has to be written in a separate buffer and then +the process has to be finished or canceled using a separate command. + + The following commands are available in buffers used to edit posts: + +‘C-c C-c’ (‘forge-post-submit’) + This command submits the post that is being edited in the current + buffer. + +‘C-c C-k’ (‘forge-post-cancel’) + This command cancels the post that is being edited in the current + buffer. + +‘C-c C-e’ (‘forge-post-dispatch’) + This prefix command features the above two commands as suffixes, + and when creating a pull-request also the following command. More + suffix commands will likely be added in the future. + +‘C-c C-e d’ (‘forge-post-toggle-draft’) + This command toggles whether the pull-request being created is a + draft. + + +File: forge.info, Node: Miscellaneous, Prev: Working with Topics, Up: Usage + +4.4 Miscellaneous +================= + +‘N c f’ (‘forge-fork’) + This command adds an additional remote to the current repository. + The remote can either point at an existing repository or one that + has to be created first by forking it to an account the user has + access to. + + Currently this only supports Github and Gitlab. + +‘N a’ (‘forge-add-repository’) + This command reads a repository from the user and adds it to the + database. The repository can be provided as a URL, a name, or in + the form OWNER/NAME. This is subject to ‘magit-clone-name-alist’. + + This command offers to either pull topics (now and in the future) + or to only pull individual topics when the user invokes + ‘forge-pull-topic’. + +‘N t t’ (‘forge-toggle-display-in-status-buffer’) + This command toggles whether any topics are displayed in the + current Magit status buffer. + +‘N t c’ (‘forge-toggle-closed-visibility’) + This command toggles whether closed topics are shown in the Magit + status buffer. + + -- Command: forge-add-user-repositories + This command reads a host and a username from the user and adds all + of that user’s repositories on that host to the local database. + + This may take a while. Only Github is supported at the moment. + + -- Command: forge-add-organization-repositories + This command reads a host and an organization from the user and + adds all the organization’s repositories on that host to the local + database. + + This may take a while. Only Github is supported at the moment. + + -- Command: forge-remove-repository + This command reads a repository and removes it from the local + database. + + -- Command: forge-remove-topic-locally + This command reads a topic and removes it from the local database. + The topic is not removed from the forge and, if it is later + modified, then it will be added to the database again. + + Due to how the supported APIs work, it would be too expensive to + automatically remove topics from the local database that were + removed from the forge. The only purpose of this command is to + allow you to manually clean up the local database. + + -- Command: forge-reset-database + This command moves the current database file to the trash and + creates a new empty database. + + This is useful after the database’s table schemata have changed, + which will happen a few times while the Forge functionality is + still under heavy development. + + +File: forge.info, Node: FAQ, Next: Keystroke Index, Prev: Usage, Up: Top + +Appendix A FAQ +************** + +This section lists some frequently asked questions. Please also see + for an extended list of common +issues. + +* Menu: + +* Is it possible to create a single pull-request without pulling everything?:: +* ‘error in process filter HTTP Error 502, "Bad gateway"’: error in process filter HTTP Error 502 "Bad gateway". + + +File: forge.info, Node: Is it possible to create a single pull-request without pulling everything?, Next: error in process filter HTTP Error 502 "Bad gateway", Up: FAQ + +A.1 Is it possible to create a single pull-request without pulling everything? +============================================================================== + +Yes. ‘M-x forge-add-repository’ offers to add a repository to the +database without also fetching all pull-requests and issues. + + +File: forge.info, Node: error in process filter HTTP Error 502 "Bad gateway", Prev: Is it possible to create a single pull-request without pulling everything?, Up: FAQ + +A.2 ‘error in process filter: HTTP Error: 502, "Bad gateway"’ +============================================================= + +This is a frequently occurring error. Adding some formatting the full +error is: + + error in process filter: ghub--signal-error: HTTP Error: 502, + "Bad gateway", "/graphql", + ((data . "null") + (errors ((message . "Something went wrong while executing your query. + This may be the result of a timeout, or it could be a GitHub bug. + Please include `CC2C:4FEA:A1771C1:CBF40CE:5C33F7E5` + when reporting this issue.")))) + + This indicates that something went wrong within Github’s network. +See +. +The appended error message also says as much: "This may be the result of +a timeout, or it could be a GitHub bug." + + It appears that this happens more often in big repositories, +especially during the initial pull, but this may be an illusion; it is +known to also happens for smaller, incremental requests. + + I believe that more data just means more requests and thus more +opportunities for things to go wrong. It seems unlikely that this is +due to us requesting too much data at once (in that case we would get a +different error from GraphQL, not HTTP). When fetching lots of data, +then we do not request one large response but make many requests and we +then collect the many responses (pagination forces us to do that). + + The timeout may be due to many requests from other people arriving at +some Github-internal bottleneck at the same time, or it may be due to +cold caches and overly aggressive timeouts. We just don’t know; it’s +their infrastructure. + + The second problem is that we currently simply error out if we get +this error. This could be changed and eventually it will be, but for +the time being your only option is to just try again, possibly +repeatedly and possibly after a delay to give whatever congestion may +exist on the other end a chance to clear or to give their caches a +chance to warm up. + + This was also discussed in +and . + + +File: forge.info, Node: Keystroke Index, Next: Function and Command Index, Prev: FAQ, Up: Top + +Appendix B Keystroke Index +************************** + +[index] +* Menu: + +* b F: Branching. (line 13) +* b f: Branching. (line 102) +* C-c C-c: Editing Topics and Posts. + (line 92) +* C-c C-e: Editing Topics and Posts. + (line 100) +* C-c C-e d: Editing Topics and Posts. + (line 105) +* C-c C-e [on "Assignees" section]: Editing Topics and Posts. + (line 56) +* C-c C-e [on "Draft" section]: Editing Topics and Posts. + (line 40) +* C-c C-e [on "Labels" section]: Editing Topics and Posts. + (line 43) +* C-c C-e [on "Marks" section]: Editing Topics and Posts. + (line 47) +* C-c C-e [on "Note" section]: Editing Topics and Posts. + (line 65) +* C-c C-e [on "Review-Requests" section]: Editing Topics and Posts. + (line 60) +* C-c C-e [on "State" section]: Editing Topics and Posts. + (line 36) +* C-c C-e [on "Title" section]: Editing Topics and Posts. + (line 32) +* C-c C-e [on a post section]: Editing Topics and Posts. + (line 27) +* C-c C-k: Editing Topics and Posts. + (line 96) +* C-c C-k [on a comment section]: Editing Topics and Posts. + (line 68) +* C-c C-n: Editing Topics and Posts. + (line 17) +* C-c C-n [on "Issues" section]: Creating Topics. (line 12) +* C-c C-n [on "Pull requests" section]: Creating Topics. (line 8) +* C-c C-r: Editing Topics and Posts. + (line 17) +* C-c C-v: Visiting Topics. (line 36) +* C-c C-w: Visiting Topics. (line 22) +* C-c C-w <1>: Visiting Topics. (line 22) +* f n: Pulling. (line 13) +* f N: Pulling. (line 25) +* m M [if enabled]: Editing Topics and Posts. + (line 72) +* N: Usage. (line 23) +* N a: Usage. (line 13) +* N a <1>: Miscellaneous. (line 15) +* N b I: Visiting Topics. (line 22) +* N b i: Visiting Topics. (line 22) +* N b P: Visiting Topics. (line 22) +* N b p: Visiting Topics. (line 22) +* N b r: Visiting Topics. (line 22) +* N b t: Visiting Topics. (line 22) +* N c f: Miscellaneous. (line 7) +* N c i: Creating Topics. (line 12) +* N c p: Creating Topics. (line 8) +* N f f: Pulling. (line 13) +* N f n: Pulling. (line 25) +* N f t: Pulling. (line 47) +* N l i: Listing Topics and Notifications. + (line 72) +* N l n: Listing Topics and Notifications. + (line 64) +* N l p: Listing Topics and Notifications. + (line 68) +* N l r: Listing Topics and Notifications. + (line 61) +* N M [if enabled]: Editing Topics and Posts. + (line 72) +* N r: Repository Detection. + (line 80) +* N t c: Miscellaneous. (line 28) +* N t t: Miscellaneous. (line 24) +* N v i: Visiting Topics. (line 36) +* N v p: Visiting Topics. (line 36) +* N v t: Visiting Topics. (line 36) +* RET: Visiting Topics. (line 36) +* Z n: Branching. (line 107) + + +File: forge.info, Node: Function and Command Index, Next: Variable Index, Prev: Keystroke Index, Up: Top + +Appendix C Function and Command Index +************************************* + +[index] +* Menu: + +* forge-add-organization-repositories: Miscellaneous. (line 37) +* forge-add-repository: Usage. (line 13) +* forge-add-repository <1>: Miscellaneous. (line 15) +* forge-add-user-repositories: Miscellaneous. (line 31) +* forge-branch-pullreq: Branching. (line 13) +* forge-browse-dwim: Visiting Topics. (line 22) +* forge-browse-issue: Visiting Topics. (line 22) +* forge-browse-issues: Visiting Topics. (line 22) +* forge-browse-pullreq: Visiting Topics. (line 22) +* forge-browse-pullreqs: Visiting Topics. (line 22) +* forge-browse-remote: Visiting Topics. (line 22) +* forge-browse-topic: Visiting Topics. (line 22) +* forge-browse-TYPE: Visiting Topics. (line 22) +* forge-checkout-pullreq: Branching. (line 102) +* forge-checkout-worktree: Branching. (line 107) +* forge-create-issue: Creating Topics. (line 12) +* forge-create-post: Editing Topics and Posts. + (line 17) +* forge-create-pullreq: Creating Topics. (line 8) +* forge-delete-comment: Editing Topics and Posts. + (line 68) +* forge-dispatch: Usage. (line 23) +* forge-edit-post: Editing Topics and Posts. + (line 27) +* forge-edit-topic-assignees: Editing Topics and Posts. + (line 56) +* forge-edit-topic-draft: Editing Topics and Posts. + (line 40) +* forge-edit-topic-labels: Editing Topics and Posts. + (line 43) +* forge-edit-topic-marks: Editing Topics and Posts. + (line 47) +* forge-edit-topic-note: Editing Topics and Posts. + (line 65) +* forge-edit-topic-review-requests: Editing Topics and Posts. + (line 60) +* forge-edit-topic-state: Editing Topics and Posts. + (line 36) +* forge-edit-topic-title: Editing Topics and Posts. + (line 32) +* forge-forge.remote: Repository Detection. + (line 80) +* forge-fork: Miscellaneous. (line 7) +* forge-insert-assigned-issues: Listing Topics and Notifications. + (line 49) +* forge-insert-assigned-pullreqs: Listing Topics and Notifications. + (line 37) +* forge-insert-authored-issues: Listing Topics and Notifications. + (line 53) +* forge-insert-authored-pullreqs: Listing Topics and Notifications. + (line 45) +* forge-insert-issues: Listing Topics and Notifications. + (line 16) +* forge-insert-pullreqs: Listing Topics and Notifications. + (line 12) +* forge-insert-requested-reviews: Listing Topics and Notifications. + (line 41) +* forge-list-assigned-issues: Listing Topics and Notifications. + (line 87) +* forge-list-assigned-pullreqs: Listing Topics and Notifications. + (line 83) +* forge-list-authored-issues: Listing Topics and Notifications. + (line 99) +* forge-list-authored-pullreqs: Listing Topics and Notifications. + (line 95) +* forge-list-issues: Listing Topics and Notifications. + (line 72) +* forge-list-labeled-issues: Listing Topics and Notifications. + (line 79) +* forge-list-labeled-pullreqs: Listing Topics and Notifications. + (line 75) +* forge-list-notifications: Listing Topics and Notifications. + (line 64) +* forge-list-owned-issues: Listing Topics and Notifications. + (line 109) +* forge-list-owned-pullreqs: Listing Topics and Notifications. + (line 103) +* forge-list-pullreqs: Listing Topics and Notifications. + (line 68) +* forge-list-repositories: Listing Topics and Notifications. + (line 61) +* forge-list-requested-reviews: Listing Topics and Notifications. + (line 91) +* forge-merge: Editing Topics and Posts. + (line 72) +* forge-post-cancel: Editing Topics and Posts. + (line 96) +* forge-post-dispatch: Editing Topics and Posts. + (line 100) +* forge-post-submit: Editing Topics and Posts. + (line 92) +* forge-post-toggle-draft: Editing Topics and Posts. + (line 105) +* forge-pull: Pulling. (line 13) +* forge-pull-notifications: Pulling. (line 25) +* forge-pull-topic: Pulling. (line 47) +* forge-remove-repository: Miscellaneous. (line 44) +* forge-remove-topic-locally: Miscellaneous. (line 48) +* forge-reset-database: Miscellaneous. (line 58) +* forge-toggle-closed-visibility: Listing Topics and Notifications. + (line 30) +* forge-toggle-closed-visibility <1>: Miscellaneous. (line 28) +* forge-toggle-display-in-status-buffer: Miscellaneous. (line 24) +* forge-visit-issue: Visiting Topics. (line 36) +* forge-visit-pullreq: Visiting Topics. (line 36) +* forge-visit-topic: Visiting Topics. (line 36) +* forge-visit-TYPE: Visiting Topics. (line 36) + + +File: forge.info, Node: Variable Index, Prev: Function and Command Index, Up: Top + +Appendix D Variable Index +************************* + +[index] +* Menu: + +* forge-alist: Repository Detection. + (line 92) +* forge-checkout-worktree-read-directory-function: Branching. (line 111) +* forge-owned-accounts: Listing Topics and Notifications. + (line 115) +* forge-owned-ignored: Listing Topics and Notifications. + (line 130) +* forge-topic-list-limit: Listing Topics and Notifications. + (line 19) +* forge.remote: Repository Detection. + (line 66) + + + +Tag Table: +Node: Top771 +Node: Introduction2475 +Node: Supported Forges and Hosts3038 +Node: Supported Forges4323 +Ref: Github4479 +Ref: Github Caveats4622 +Ref: Github Hosts5268 +Ref: Gitlab5324 +Ref: Gitlab Caveats5339 +Ref: Gitlab Hosts5464 +Node: Partially Supported Forges5584 +Ref: Gitea https//giteaio5790 +Ref: Gitea Hosts5890 +Ref: Gogs https//gogsio5946 +Ref: Gogs Hosts6149 +Ref: Bitbucket https//bitbucketorg6207 +Ref: Bitbucket Caveats6405 +Ref: Bitbucket Hosts7302 +Node: Supported Semi-Forges7367 +Ref: Gitweb https//git-scmcom/docs/gitweb7538 +Ref: Gitweb Caveats7617 +Ref: Cgit https//gitzx2c4com/cgit/about7857 +Ref: Cgit Caveats7934 +Ref: Cgit Hosts8283 +Ref: Stgit https//codemadnessorg/git/stagit/file/READMEhtml8410 +Ref: Stgit Caveats8527 +Ref: Stgit Hosts8813 +Ref: Srht https//metasrht8873 +Ref: Srht Caveats8922 +Ref: Srht Hosts9205 +Node: Getting Started9256 +Node: Loading Forge10254 +Node: Token Creation10649 +Node: Initial Pull11928 +Node: Repository Detection13323 +Node: Caveats18690 +Node: Usage19616 +Node: Pulling21088 +Node: Branching23771 +Node: Working with Topics30166 +Node: Visiting Topics30539 +Node: Listing Topics and Notifications32616 +Node: Creating Topics37930 +Node: Editing Topics and Posts38419 +Node: Miscellaneous42946 +Node: FAQ45569 +Node: Is it possible to create a single pull-request without pulling everything?46037 +Node: error in process filter HTTP Error 502 "Bad gateway"46503 +Node: Keystroke Index48874 +Node: Function and Command Index54564 +Node: Variable Index62522 + +End Tag Table + + +Local Variables: +coding: utf-8 +End: -- 2.47.3