From: Andreas Gerler Date: Sun, 22 Dec 2024 12:00:02 +0000 (+0100) Subject: update forge X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=4415e974e881113d3d8984045ea7d632784c22ae;p=emacsconfig.git update forge Signed-off-by: Andreas Gerler --- diff --git a/elpa/forge-20240523.1103/dir b/elpa/forge-20240523.1103/dir deleted file mode 100644 index e9289b26..00000000 --- a/elpa/forge-20240523.1103/dir +++ /dev/null @@ -1,18 +0,0 @@ -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 deleted file mode 100644 index cce3a830..00000000 --- a/elpa/forge-20240523.1103/forge-autoloads.el +++ /dev/null @@ -1,302 +0,0 @@ -;;; 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 deleted file mode 100644 index e4cf219a..00000000 --- a/elpa/forge-20240523.1103/forge-bitbucket.el +++ /dev/null @@ -1,46 +0,0 @@ -;;; 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 deleted file mode 100644 index 1abd89bd..00000000 --- a/elpa/forge-20240523.1103/forge-commands.el +++ /dev/null @@ -1,1133 +0,0 @@ -;;; 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 deleted file mode 100644 index 47b5b879..00000000 --- a/elpa/forge-20240523.1103/forge-core.el +++ /dev/null @@ -1,395 +0,0 @@ -;;; 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 deleted file mode 100644 index f7df96b4..00000000 --- a/elpa/forge-20240523.1103/forge-db.el +++ /dev/null @@ -1,549 +0,0 @@ -;;; 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 deleted file mode 100644 index a12881fa..00000000 --- a/elpa/forge-20240523.1103/forge-gitea.el +++ /dev/null @@ -1,47 +0,0 @@ -;;; 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 deleted file mode 100644 index 8b807082..00000000 --- a/elpa/forge-20240523.1103/forge-github.el +++ /dev/null @@ -1,858 +0,0 @@ -;;; 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 deleted file mode 100644 index 55c4b454..00000000 --- a/elpa/forge-20240523.1103/forge-gitlab.el +++ /dev/null @@ -1,684 +0,0 @@ -;;; 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 deleted file mode 100644 index 6f2d372e..00000000 --- a/elpa/forge-20240523.1103/forge-gogs.el +++ /dev/null @@ -1,46 +0,0 @@ -;;; 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 deleted file mode 100644 index 614d7ca8..00000000 --- a/elpa/forge-20240523.1103/forge-issue.el +++ /dev/null @@ -1,278 +0,0 @@ -;;; 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 deleted file mode 100644 index 4415cdf5..00000000 --- a/elpa/forge-20240523.1103/forge-notify.el +++ /dev/null @@ -1,327 +0,0 @@ -;;; 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 deleted file mode 100644 index b12d4495..00000000 --- a/elpa/forge-20240523.1103/forge-pkg.el +++ /dev/null @@ -1,23 +0,0 @@ -(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 deleted file mode 100644 index 084a9b7b..00000000 --- a/elpa/forge-20240523.1103/forge-post.el +++ /dev/null @@ -1,255 +0,0 @@ -;;; 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 deleted file mode 100644 index 6ff5c4be..00000000 --- a/elpa/forge-20240523.1103/forge-pullreq.el +++ /dev/null @@ -1,358 +0,0 @@ -;;; 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 deleted file mode 100644 index 998831a0..00000000 --- a/elpa/forge-20240523.1103/forge-repo.el +++ /dev/null @@ -1,531 +0,0 @@ -;;; 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 deleted file mode 100644 index 93a6b6b5..00000000 --- a/elpa/forge-20240523.1103/forge-repos.el +++ /dev/null @@ -1,193 +0,0 @@ -;;; 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 deleted file mode 100644 index da550632..00000000 --- a/elpa/forge-20240523.1103/forge-revnote.el +++ /dev/null @@ -1,47 +0,0 @@ -;;; 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 deleted file mode 100644 index a7f68068..00000000 --- a/elpa/forge-20240523.1103/forge-semi.el +++ /dev/null @@ -1,83 +0,0 @@ -;;; 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 deleted file mode 100644 index 31e2561e..00000000 --- a/elpa/forge-20240523.1103/forge-tablist.el +++ /dev/null @@ -1,85 +0,0 @@ -;;; 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 deleted file mode 100644 index df2f0c38..00000000 --- a/elpa/forge-20240523.1103/forge-topic.el +++ /dev/null @@ -1,1566 +0,0 @@ -;;; 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 deleted file mode 100644 index ddf81e4f..00000000 --- a/elpa/forge-20240523.1103/forge-topics.el +++ /dev/null @@ -1,488 +0,0 @@ -;;; 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 deleted file mode 100644 index 5a4f93b3..00000000 --- a/elpa/forge-20240523.1103/forge.el +++ /dev/null @@ -1,169 +0,0 @@ -;;; 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 deleted file mode 100644 index bd873922..00000000 --- a/elpa/forge-20240523.1103/forge.info +++ /dev/null @@ -1,1537 +0,0 @@ -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: diff --git a/elpa/forge-20241218.2036/dir b/elpa/forge-20241218.2036/dir new file mode 100644 index 00000000..e9289b26 --- /dev/null +++ b/elpa/forge-20241218.2036/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-20241218.2036/forge-autoloads.el b/elpa/forge-20241218.2036/forge-autoloads.el new file mode 100644 index 00000000..af1141c4 --- /dev/null +++ b/elpa/forge-20241218.2036/forge-autoloads.el @@ -0,0 +1,282 @@ +;;; 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" nil t) +(autoload 'forge-pull-notifications "forge-commands" nil t) +(autoload 'forge-pull-topic "forge-commands" nil t) +(autoload 'forge-pull-this-topic "forge-commands" nil t) +(autoload 'forge-browse-issues "forge-commands" "\ +Visit the current repository's issues using a browser." t) +(autoload 'forge-browse-pullreqs "forge-commands" "\ +Visit the current repository's pull-requests using a browser." t) +(autoload 'forge-browse-topic "forge-commands" "\ +Read a TOPIC and visit it using a browser. +By default only offer open topics but with a prefix argument +also offer closed topics. + +(fn TOPIC)" t) +(autoload 'forge-browse-issue "forge-commands" "\ +Read an ISSUE and visit it using a browser. +By default only offer open issues but with a prefix argument +also offer closed issues. + +(fn ISSUE)" t) +(autoload 'forge-browse-pullreq "forge-commands" "\ +Read a PULL-REQUEST and visit it using a browser. +By default only offer open pull-requests but with a prefix +argument also offer closed pull-requests. + +(fn PULL-REQUEST)" t) +(autoload 'forge-browse-commit "forge-commands" "\ +Read a COMMIT and visit it using a browser. + +(fn COMMIT)" t) +(autoload 'forge-browse-branch "forge-commands" "\ +Read a BRANCH and visit it using a browser. + +(fn BRANCH)" t) +(autoload 'forge-browse-remote "forge-commands" "\ +Read a REMOTE and visit it using a browser. + +(fn REMOTE)" t) +(autoload 'forge-browse-repository "forge-commands" "\ +Read a REPOSITORY and visit it using a browser. + +(fn REPOSITORY)" t) +(autoload 'forge-browse-this-topic "forge-commands" nil t) +(autoload 'forge-browse-this-repository "forge-commands" "\ +Visit the repository at point using a browser." t) +(autoload 'forge-copy-url-at-point-as-kill "forge-commands" "\ +Copy the url of the thing at point." t) +(autoload 'forge-browse "forge-commands" "\ +Visit the thing at point using a browser." t) +(autoload 'forge-visit-topic "forge-commands" "\ +Read a TOPIC and visit it. +By default only offer active topics for completion. With a prefix +argument offer all topics. While completion is in progress, \\\\[forge-read-topic-lift-limit] lifts +the limitation to active topics. + +(fn TOPIC)" t) +(autoload 'forge-visit-issue "forge-commands" "\ +Read an ISSUE and visit it. +By default only offer active issues for completion. With a prefix +argument offer all topics. While completion is in progress, \\\\[forge-read-topic-lift-limit] lifts +the limitation to active issues. + +(fn ISSUE)" t) +(autoload 'forge-visit-pullreq "forge-commands" "\ +Read a PULL-REQUEST and visit it. +By default only offer active pull-requests for completion. With a +prefix argument offer all topics. While completion is in progress, +\\\\[forge-read-topic-lift-limit] lifts the limitation to active pull-requests. + +(fn PULL-REQUEST)" t) +(autoload 'forge-visit-this-topic "forge-commands" "\ +Visit the topic at point. +With prefix argument MENU, also show the topic menu. + +(fn &optional MENU)" t) +(autoload 'forge-visit-this-repository "forge-commands" "\ +Visit the repository at point." t) +(autoload 'forge-branch-pullreq "forge-commands" "\ +Create and configure a new branch from a pull-request. +Please see the manual for more information. + +(fn PULLREQ)" t) +(autoload 'forge-checkout-pullreq "forge-commands" "\ +Create, configure and checkout a new branch from a pull-request. +Please see the manual for more information. + +(fn PULLREQ)" t) +(autoload 'forge-checkout-this-pullreq "forge-commands" nil t) +(autoload 'forge-checkout-worktree "forge-commands" "\ +Create, configure and checkout a new worktree from a pull-request. +This is like `forge-checkout-pullreq', except that it also +creates a new worktree. Please see the manual for more +information. + +(fn PATH PULLREQ)" t) +(autoload 'forge-fork "forge-commands" "\ +Fork the current repository to FORK and add it as a REMOTE. +If the fork already exists, then that isn't an error; the remote +is added anyway. Currently this only supports Github and Gitlab. + +(fn FORK REMOTE)" t) +(autoload 'forge-merge "forge-commands" nil t) +(autoload 'forge-rename-default-branch "forge-commands" "\ +Rename the default branch to NEWNAME. +Change the name on the upstream remotely and locally, and update the +upstream remotes of local branches accordingly." t) +(autoload 'forge-add-pullreq-refspec "forge-commands" nil t) +(autoload 'forge-add-repository "forge-commands" nil t) +(autoload 'forge-add-user-repositories "forge-commands" "\ +Add all of USER's repositories from HOST to the database. +This may take a while. Only Github is supported at the moment. + +(fn HOST USER)" t) +(autoload 'forge-add-organization-repositories "forge-commands" "\ +Add all of ORGANIZATION's repositories from HOST to the database. +This may take a while. Only Github is supported at the moment. + +(fn HOST ORGANIZATION)" t) +(autoload 'forge-remove-repository "forge-commands" "\ +Remove a repository from the database. + +(fn REPOSITORY)" t) +(autoload 'forge-remove-topic-locally "forge-commands" "\ +Remove a topic from the local database only. +Due to how the supported APIs work, it would be too expensive to +automatically remove topics from the local database that were +removed from the forge. The purpose of this command is to allow +you to manually clean up the local database. + +(fn TOPIC)" t) +(autoload 'forge-reset-database "forge-commands" "\ +Move the current database file to the trash. +This is useful after the database scheme has changed, which will +happen a few times while the forge functionality is still under +heavy development." t) +(register-definition-prefixes "forge-commands" '("forge-")) + + +;;; 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" nil 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--tab")) + + +;;; 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-issues "forge-topics" nil t) +(autoload 'forge-list-pullreqs "forge-topics" nil t) +(autoload 'forge-list-global-topics "forge-topics" nil t) +(autoload 'forge-list-global-issues "forge-topics" nil t) +(autoload 'forge-list-global-pullreqs "forge-topics" nil t) +(register-definition-prefixes "forge-topics" '("forge-")) + +;;; 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-20241218.2036/forge-bitbucket.el b/elpa/forge-20241218.2036/forge-bitbucket.el new file mode 100644 index 00000000..e4cf219a --- /dev/null +++ b/elpa/forge-20241218.2036/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-20241218.2036/forge-commands.el b/elpa/forge-20241218.2036/forge-commands.el new file mode 100644 index 00000000..ecfec1db --- /dev/null +++ b/elpa/forge-20241218.2036/forge-commands.el @@ -0,0 +1,1249 @@ +;;; 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." + :transient-non-suffix #'transient--do-call + :refresh-suffixes t + :environment #'forge--menu-environment + :column-widths forge--topic-menus-column-widths + [forge--topic-menus-group + ["Fetch" + ("f f" "all topics" forge-pull) + ("f t" "one topic" forge-pull-topic) + ("f n" "notifications" forge-pull-notifications)] + ["Create" + :if forge--get-repository:tracked? + ("c i" "issue" forge-create-issue) + ("c p" "pull-request" forge-create-pullreq) + ("c u" "pr from issue" forge-create-pullreq-from-issue) + ("c f" "fork or remote" forge-fork)] + [:description (lambda () + (cond + ((forge--get-repository:tracked?) "Actions") + ((or (magit-gitdir) (forge-repository-at-point)) + "Forge does not yet track this repository") + ("Not inside a Git repository"))) + ("/a" forge-add-repository + :description (lambda () (let ((repo (forge-get-repository :stub?))) + (if (or (not repo) + (eq (oref repo condition) :tracked)) + "track some repo" + "track this repository")))) + ("/M" "merge with api" forge-merge + :if forge--get-repository:tracked? :level 7)]] + [forge--lists-group + ["Visit" + :inapt-if-not forge--get-repository:tracked? + ("v t" "topic" forge-visit-topic) + ("v i" "issue" forge-visit-issue) + ("v p" "pull-request" forge-visit-pullreq)] + ["Browse" + ("b t" "topic" forge-browse-topic + :inapt-if-not forge--get-repository:tracked?) + ("b i" "issue" forge-browse-issue + :inapt-if-not forge--get-repository:tracked?) + ("b p" "pull-request" forge-browse-pullreq + :inapt-if-not forge--get-repository:tracked?) + ("b r" "remote" forge-browse-remote) + ("b I" "issues" forge-browse-issues) + ("b P" "pull-requests" forge-browse-pullreqs) + ""] + ["Display" + ("-S" forge-toggle-display-in-status-buffer + :inapt-if-not forge--buffer-with-topics-sections-p) + ("-H" forge-toggle-topic-legend)]] + [forge--topic-legend-group]) + +(transient-augment-suffix forge-dispatch + :transient #'transient--do-replace + :inapt-if (lambda () (eq (oref transient--prefix command) 'forge-dispatch)) + :inapt-face 'forge-suffix-active) + +;;;###autoload(autoload 'forge-configure "forge-commands" nil t) +(transient-define-prefix forge-configure () + "Configure current repository and global settings." + :transient-non-suffix #'transient--do-call + :refresh-suffixes t + :environment #'forge--menu-environment + :column-widths forge--topic-menus-column-widths + [forge--topic-menus-group + ["Configure" + ("R " forge-add-pullreq-refspec) + ("s r" forge-forge.remote) + ("s l" forge-forge.graphqlItemLimit)]]) + +(transient-augment-suffix forge-configure + :transient #'transient--do-replace + :inapt-if (lambda () (eq (oref transient--prefix command) 'forge-configure)) + :inapt-face 'forge-suffix-active) + +;;; Pull + +;;;###autoload(autoload 'forge-pull "forge-commands" nil t) +(transient-define-suffix forge-pull () + "Pull forge topics for the current repository if it is already tracked. +If the current repository is still untracked locally, or the current +repository cannot be determined, instead invoke `forge-add-repository'." + :description (lambda () + (if (forge-get-repository :tracked?) + "forge topics" + "new forge repository")) + (declare (interactive-only nil)) + (interactive) + (if-let ((repo (forge-get-repository :tracked?))) + (forge--pull repo) + (transient-setup 'forge-add-repository nil nil + :scope (forge-add-repository--scope)))) + +(defun forge-read-date (prompt) + (require (quote org) nil) + (if (fboundp 'org-read-date) + (org-read-date nil nil nil prompt) + (cl-block nil + (while t + (let ((str (read-from-minibuffer prompt))) + (cond ((string-equal str "") + (cl-return nil)) + ((string-match-p + "\\`[0-9]\\{4\\}[-/][0-9]\\{2\\}[-/][0-9]\\{2\\}\\'" str) + (cl-return str)))) + (message "Please enter a date in the format YYYY-MM-DD.") + (sit-for 1))))) + +(cl-defmethod forge--pull ((repo forge-noapi-repository) &rest _) + (forge--msg repo t t "Pulling from REPO is not supported")) + +(cl-defmethod forge--pull ((repo forge-unusedapi-repository) &rest _) + (magit-git-fetch (oref repo remote) (magit-fetch-arguments))) + +(defun forge--maybe-git-fetch (repo &optional buffer) + (if (buffer-live-p buffer) + (with-current-buffer buffer + (if (and (derived-mode-p 'magit-mode) + (forge-repository-equal (forge-get-repository :stub?) repo) + (magit-toplevel)) + (magit-git-fetch (oref repo remote) (magit-fetch-arguments)) + (magit-refresh-buffer))) + (when-let ((worktree (forge-get-worktree repo))) + (let ((default-directory worktree) + (magit-inhibit-refresh t)) + (magit-git-fetch (oref repo remote) (magit-fetch-arguments)))))) + +;;;###autoload(autoload 'forge-pull-notifications "forge-commands" nil t) +(transient-define-suffix forge-pull-notifications () + "Fetch notifications for all repositories from the current forge." + :description "forge notifications" + (interactive) + (if-let ((repo (forge-get-repository :stub?))) + (let ((class (eieio-object-class repo))) + (if (eq class 'forge-github-repository) + (forge--pull-notifications class (oref repo githost)) + (user-error "Fetching notifications not supported for forge %S" + (oref repo forge)))) + (forge--pull-notifications 'forge-github-repository "github.com"))) + +;;;###autoload(autoload 'forge-pull-topic "forge-commands" nil t) +(transient-define-suffix forge-pull-topic (number) + "Read a topic TYPE and NUMBER pull data about it from its forge." + :inapt-if-not (lambda () (and (forge--get-repository:tracked?) + (forge--get-github-repository))) + (interactive + (list (read-number "Pull topic: " + (and-let* ((topic (forge-current-topic))) + (oref topic number))))) + (forge--pull-topic (forge-get-repository :tracked) number)) + +;;;###autoload(autoload 'forge-pull-this-topic "forge-commands" nil t) +(transient-define-suffix forge-pull-this-topic () + "Pull data about the topic at point from its forge." + :inapt-if-not #'forge--get-github-repository + :description "fetch" + (interactive) + (let ((topic (forge-current-topic t))) + (forge--pull-topic (forge-get-repository topic) topic))) + +(cl-defmethod forge--pull-topic ((repo forge-repository) _topic) + (error "Fetching an individual topic not implemented for %s" + (eieio-object-class repo))) + +;;; Browse + +;;;###autoload +(defun forge-browse-issues () + "Visit the current repository's issues using a browser." + (interactive) + (browse-url (forge--format (forge-get-repository :stub) + 'issues-url-format))) + +;;;###autoload +(defun forge-browse-pullreqs () + "Visit the current repository's pull-requests using a browser." + (interactive) + (browse-url (forge--format (forge-get-repository :stub) + 'pullreqs-url-format))) + +;;;###autoload +(defun forge-browse-topic (topic) + "Read a TOPIC and visit it using a browser. +By default only offer open topics but with a prefix argument +also offer closed topics." + (interactive (list (forge-read-topic "Browse topic"))) + (forge--browse-topic topic)) + +;;;###autoload +(defun forge-browse-issue (issue) + "Read an ISSUE and visit it using a browser. +By default only offer open issues but with a prefix argument +also offer closed issues." + (interactive (list (forge-read-issue "Browse issue"))) + (forge--browse-topic issue)) + +;;;###autoload +(defun forge-browse-pullreq (pull-request) + "Read a PULL-REQUEST and visit it using a browser. +By default only offer open pull-requests but with a prefix +argument also offer closed pull-requests." + (interactive (list (forge-read-pullreq "Browse pull-request"))) + (forge--browse-topic pull-request)) + +(defun forge--browse-topic (topic) + (let ((obj (forge-get-topic topic))) + (browse-url (forge-get-url obj)) + (forge-topic-mark-read obj))) + +;;;###autoload +(defun forge-browse-commit (commit) + "Read a COMMIT and visit it using a browser." + (interactive + (list (or (magit-completing-read "Browse commit" + (magit-list-branch-names) + nil nil nil 'magit-revision-history + (magit-branch-or-commit-at-point)) + (user-error "Nothing selected")))) + (browse-url (forge-get-url :commit commit))) + +;;;###autoload +(defun forge-browse-branch (branch) + "Read a BRANCH and visit it using a browser." + (interactive (list (magit-read-branch "Browse branch"))) + (browse-url (forge-get-url :branch branch))) + +;;;###autoload +(defun forge-browse-remote (remote) + "Read a REMOTE and visit it using a browser." + (interactive (list (magit-read-remote "Browse remote" nil t))) + (browse-url (forge-get-url :remote remote))) + +;;;###autoload +(defun forge-browse-repository (repository) + "Read a REPOSITORY and visit it using a browser." + (interactive (list (forge-read-repository "Browse repository"))) + (browse-url (forge-get-url repository))) + +;;;###autoload(autoload 'forge-browse-this-topic "forge-commands" nil t) +(transient-define-suffix forge-browse-this-topic () + "Visit the topic at point using a browser." + :description "browse" + (interactive) + (forge-browse-topic (forge-current-topic t))) + +;;;###autoload +(defun forge-browse-this-repository () + "Visit the repository at point using a browser." + (interactive) + (forge-browse-repository (forge-repository-at-point t))) + +;;;###autoload +(defun forge-copy-url-at-point-as-kill () + "Copy the url of the thing at point." + (interactive) + (if-let ((target (forge--browse-target))) + (let ((url (if (stringp target) target (forge-get-url target)))) + (kill-new url) + (message "Copied \"%s\"" url)) + (user-error "Nothing at point with a URL"))) + +;;;###autoload +(defun forge-browse () + "Visit the thing at point using a browser." + (interactive) + (if-let ((target (forge--browse-target))) + (if (stringp target) + (browse-url target) + (browse-url (forge-get-url target)) + (when (cl-typep target 'forge-topic) + (forge-topic-mark-read target))) + (user-error "Nothing to browse here"))) + +(defun forge--browse-target () + (or (and-let* ((branch (magit--painted-branch-at-point))) + (forge-get-url :branch branch)) + (and-let* ((commit (magit-commit-at-point))) + (forge-get-url :commit commit)) + (and-let* ((branch (magit-branch-at-point))) + (forge-get-url :branch branch)) + (and-let* ((remote (magit-remote-at-point))) + (forge-get-url :remote remote)) + (forge-post-at-point) + (forge-current-topic) + (and magit-buffer-revision + (forge-get-url :commit magit-buffer-revision)) + (forge-get-repository :stub?))) + +;;;; Urls + +(cl-defgeneric forge-get-url (obj) + "Return the URL for a forge object.") + +(cl-defmethod forge-get-url ((issue forge-issue)) + (forge--format issue 'issue-url-format)) + +(cl-defmethod forge-get-url ((pullreq forge-pullreq)) + (forge--format pullreq 'pullreq-url-format)) + +(cl-defmethod forge-get-url ((repo forge-repository)) + (forge--format repo 'remote-url-format)) + +(cl-defmethod forge-get-url ((_(eql :commit)) commit) + (let ((repo (forge-get-repository :stub))) + (unless (magit-list-containing-branches + commit "-r" (concat (oref repo remote) "/*")) + (if-let* ((branch (car (magit-list-containing-branches commit "-r"))) + (remote (car (magit-split-branch-name branch)))) + (setq repo (forge-get-repository :stub remote)) + (message "%s does not appear to be available on any remote. %s" + commit "You might have to push it first."))) + (forge--format repo 'commit-url-format + `((?r . ,(magit-commit-p commit)))))) + +(cl-defmethod forge-get-url ((_(eql :branch)) branch) + (let (remote) + (if (magit-remote-branch-p branch) + (pcase-setq `(,remote . ,branch) (magit-split-branch-name branch)) + (unless (setq remote (or (magit-get-push-remote branch) + (magit-get-upstream-remote branch))) + (user-error "Cannot determine remote for %s" branch))) + (forge--format (forge-get-repository :stub remote) + 'branch-url-format + `((?r . ,branch))))) + +(cl-defmethod forge-get-url ((_(eql :remote)) remote) + (forge--format (forge-get-repository :stub remote) 'remote-url-format)) + +(cl-defmethod forge-get-url ((post forge-post)) + (forge--format post (let ((topic (forge-get-parent post))) + (cond ((forge--childp topic 'forge-issue) + 'issue-post-url-format) + ((forge--childp topic 'forge-pullreq) + 'pullreq-post-url-format))))) + +(cl-defmethod forge-get-url ((notify forge-notification)) + (oref notify url)) + +;;; Visit + +;;;###autoload +(defun forge-visit-topic (topic) + "Read a TOPIC and visit it. +By default only offer active topics for completion. With a prefix +argument offer all topics. While completion is in progress, \ +\\\\[forge-read-topic-lift-limit] lifts +the limitation to active topics." + (interactive (list (forge-read-topic "View topic"))) + (forge-topic-setup-buffer (forge-get-topic topic))) + +;;;###autoload +(defun forge-visit-issue (issue) + "Read an ISSUE and visit it. +By default only offer active issues for completion. With a prefix +argument offer all topics. While completion is in progress, \ +\\\\[forge-read-topic-lift-limit] lifts +the limitation to active issues." + (interactive (list (forge-read-issue "View issue"))) + (forge-topic-setup-buffer (forge-get-issue issue))) + +;;;###autoload +(defun forge-visit-pullreq (pull-request) + "Read a PULL-REQUEST and visit it. +By default only offer active pull-requests for completion. With a +prefix argument offer all topics. While completion is in progress, +\\\\[forge-read-topic-lift-limit] \ +lifts the limitation to active pull-requests." + (interactive (list (forge-read-pullreq "View pull-request"))) + (forge-topic-setup-buffer (forge-get-pullreq pull-request))) + +;;;###autoload +(defun forge-visit-this-topic (&optional menu) + "Visit the topic at point. +With prefix argument MENU, also show the topic menu." + (interactive (list current-prefix-arg)) + (forge-topic-setup-buffer (forge-topic-at-point)) + (cond + ((eq transient-current-command 'forge-topic-menu) + (setq forge--quit-keep-topic-menu t)) + ((or menu + (memq transient-current-command + '(forge-topics-menu forge-notifications-menu))) + (transient-setup 'forge-topic-menu)))) + +;;;###autoload +(defun forge-visit-this-repository () + "Visit the repository at point." + (interactive) + (let* ((repo (forge-repository-at-point)) + (worktree (forge-get-worktree repo))) + (cond + ((and (eq transient-current-command 'forge-repositories-menu) + (forge-get-repository repo nil :tracked?)) + (if-let ((buffer (get-buffer (forge-topics-buffer-name repo)))) + (progn (switch-to-buffer buffer) + (transient-setup 'forge-topics-menu)) + (forge-list-topics repo))) + (worktree + (magit-status-setup-buffer worktree)) + ((forge-get-repository repo nil :tracked?) + (forge-list-topics repo)) + ((user-error "Not tracked and location of clone is unknown"))))) + +;;; Create + +(defun forge-create-issue () + "Create a new issue for the current repository." + (interactive) + (let* ((repo (forge-get-repository :tracked)) + (buf (forge--prepare-post-buffer + "new-issue" + (forge--format repo "Create new issue on %p")))) + (when buf + (with-current-buffer buf + (setq forge--buffer-post-object repo) + (setq forge--submit-post-function #'forge--submit-create-issue)) + (forge--display-post-buffer buf)))) + +(defun forge-create-pullreq (source target) + "Create a new pull-request for the current repository." + (interactive (forge-create-pullreq--read-args)) + (let* ((repo (forge-get-repository :tracked)) + (buf (forge--prepare-post-buffer + "new-pullreq" + (forge--format repo "Create new pull-request on %p") + source target))) + (with-current-buffer buf + (setq forge--buffer-base-branch target) + (setq forge--buffer-head-branch source) + (setq forge--buffer-post-object repo) + (setq forge--submit-post-function #'forge--submit-create-pullreq) + (run-hooks 'forge-create-pullreq-hook)) + (forge--display-post-buffer buf))) + +(transient-define-suffix forge-create-pullreq-from-issue (issue source target) + "Convert an existing ISSUE into a pull-request." + :description "convert to pull-request" + :if (lambda () + (and (forge--get-github-repository) + (let ((issue (forge-current-issue))) + (and issue (eq (oref issue state) 'open) + issue)))) + (interactive (cons (forge-read-open-issue "Convert issue") + (forge-create-pullreq--read-args))) + (setq issue (forge-get-issue issue)) + (forge--create-pullreq-from-issue (forge-get-repository issue) + issue source target)) + +(defun forge-create-pullreq--read-args () + (let* ((source (magit-completing-read + "Source branch" + (magit-list-remote-branch-names) + nil t nil 'magit-revision-history + (or (and-let* ((d (magit-branch-at-point))) + (if (magit-remote-branch-p d) + d + (magit-get-push-branch d t))) + (and-let* ((d (magit-get-current-branch))) + (if (magit-remote-branch-p d) + d + (magit-get-push-branch d t)))))) + (repo (forge-get-repository :tracked)) + (remote (oref repo remote)) + (targets (delete source (magit-list-remote-branch-names remote))) + (target (magit-completing-read + "Target branch" targets nil t nil 'magit-revision-history + (let* ((d (cdr (magit-split-branch-name source))) + (d (and (magit-branch-p d) d)) + (d (and d (magit-get-upstream-branch d))) + (d (and d (if (magit-remote-branch-p d) + d + (magit-get-upstream-branch d)))) + (d (or d (concat remote "/" + (or (oref repo default-branch) + "master"))))) + (car (member d targets)))))) + (list source target))) + +(defun forge-create-post (&optional quote) + "Create a new post on an existing topic. +If the region is active, then quote that part of the post. +Otherwise and with a prefix argument quote the post that +point is currently on." + (interactive (list current-prefix-arg)) + (unless (derived-mode-p 'forge-topic-mode) + (user-error "This command is only available from topic buffers")) + (let* ((topic forge-buffer-topic) + (buf (forge--prepare-post-buffer + (forge--format topic "%i;new-comment") + (forge--format topic "New comment on #%i of %p"))) + (quote (cond + ((not (magit-section-match 'post)) nil) + ((use-region-p) + (buffer-substring-no-properties (region-beginning) + (region-end))) + (quote + (let ((section (magit-current-section))) + (string-trim-right + (buffer-substring-no-properties (oref section content) + (oref section end)))))))) + (with-current-buffer buf + (setq forge--buffer-post-object topic) + (setq forge--submit-post-function #'forge--submit-create-post) + (when quote + (goto-char (point-max)) + (unless (bobp) + (insert "\n")) + (insert (replace-regexp-in-string "^" "> " quote) "\n\n"))) + (forge--display-post-buffer buf))) + +;;; Edit + +(defun forge-edit-post () + "Edit the current post." + (interactive) + (let* ((post (forge-post-at-point t)) + (buf (cl-typecase post + (forge-topic + (forge--prepare-post-buffer + (forge--format post "%i") + (forge--format post "Edit #%i of %p"))) + (forge-post + (forge--prepare-post-buffer + (forge--format post "%i;%I") + (forge--format post "Edit comment on #%i of %p")))))) + (with-current-buffer buf + (setq forge--buffer-post-object post) + (setq forge--submit-post-function #'forge--submit-edit-post) + (erase-buffer) + (when (cl-typep post 'forge-topic) + (insert "# " (oref post title) "\n\n")) + (insert (oref post body))) + (forge--display-post-buffer buf))) + +(transient-define-suffix forge-edit-topic-note () + "Edit your private note about the current topic." + :transient #'transient--do-quit-all + :description + (lambda () + (if-let ((topic (forge-current-topic))) + (concat "note " + (if-let ((note (oref topic note))) + (propertize (substring note 0 (string-match-p "$" note)) + 'face 'font-lock-string-face) + (propertize "none" 'face 'magit-dimmed))) + "note")) + (interactive) + (if-let* ((topic (forge-current-topic t)) + (repo (forge-get-repository topic)) + (default-directory (forge-get-worktree repo)) + (buf (forge--prepare-post-buffer + (forge--format topic "%i;note") + (forge--format topic "New note on #%i of %p")))) + (progn + (with-current-buffer buf + (setq forge--buffer-post-object topic) + (setq forge--submit-post-function #'forge--save-note) + (erase-buffer) + (when-let ((note (oref topic note))) + (save-excursion (insert note ?\n)))) + (forge--display-post-buffer buf)) + (message "Cannot determine topic or worktree"))) + +;;; Delete + +(transient-define-suffix forge-delete-comment () + "Delete the comment at point." + :description "delete comment" + :inapt-if-not #'forge-comment-at-point + (interactive) + (let ((comment (forge-comment-at-point t))) + (when (yes-or-no-p "Really delete the current comment? ") + (forge--delete-comment (forge-get-repository :tracked) comment)))) + +;;; Branch + +;;;###autoload +(defun forge-branch-pullreq (pullreq) + "Create and configure a new branch from a pull-request. +Please see the manual for more information." + (interactive (list (forge-read-pullreq "Branch pull request"))) + (let ((pullreq (forge-get-pullreq pullreq))) + (if-let ((branch (forge--pullreq-branch-active pullreq))) + (progn (message "Branch %S already exists and is configured" branch) + branch) + (forge--branch-pullreq (forge-get-repository pullreq) pullreq) + (forge-refresh-buffer)))) + +(cl-defmethod forge--branch-pullreq ((pullreq forge-pullreq)) + (forge--branch-pullreq (forge-get-repository pullreq) pullreq)) + +(cl-defmethod forge--branch-pullreq ((_repo forge-unusedapi-repository) pullreq) + ;; We don't know enough to do a good job. + (let* ((number (oref pullreq number)) + (branch (format "pr-%s" number))) + (when (magit-branch-p branch) + (user-error "Branch `%s' already exists" branch)) + (magit-git "branch" branch (forge--pullreq-ref pullreq)) + ;; More often than not this is the correct target branch. + (magit-call-git "branch" branch "--set-upstream-to=master") + (magit-set (number-to-string number) "branch" branch "pullRequest") + branch)) + +(cl-defmethod forge--branch-pullreq ((repo forge-repository) pullreq) + (let* ((number (oref pullreq number)) + (branch-n (format "pr-%s" number)) + (branch (or (forge--pullreq-branch-internal pullreq) branch-n)) + (pullreq-ref (format "refs/pullreqs/%s" number))) + (cond ((and-let* ((pr-branch (oref pullreq head-ref))) + (string-search ":" pr-branch)) + ;; Such a branch name would be invalid. If we encounter + ;; it anyway, then that means that the source branch and + ;; the merge-request ref are missing. Luckily Gitlab no + ;; longer does this, but we nevertheless have to deal + ;; with merge-requests that have been lost in time. + (error "Cannot check out this merge-request because %s" + "on old Gitlab version discarded the source branch")) + ((not (eq (oref pullreq state) 'open)) + (magit-git "branch" "--force" branch pullreq-ref)) + (t + (let ((upstream (oref repo remote)) + (pr-remote (oref pullreq head-user)) + (pr-branch (oref pullreq head-ref))) + (cond ((not (oref pullreq cross-repo-p)) + (let ((tracking (concat upstream "/" pr-branch))) + (unless (magit-branch-p tracking) + (magit-call-git "fetch" upstream)) + (forge--setup-pullreq-branch branch tracking) + (magit-branch-maybe-adjust-upstream branch tracking) + (magit-set upstream "branch" branch "pushRemote") + (magit-set upstream "branch" branch "pullRequestRemote"))) + ((not pr-branch) + ;; The pullreq branch (on Github) has been deleted. + (setq pr-remote nil) + (setq branch branch-n) + (forge--setup-pullreq-branch branch pullreq-ref) + (magit-set upstream "branch" branch "pushRemote")) + (t + ;; For prs within the upstream we are more permissive, + ;; but any request to merge a branch with a well known + ;; name from fork, is highly suspicious and likely the + ;; result of a contributor not bothering to name their + ;; feature branch. + (when (and (member branch magit-main-branch-names) + (magit-branch-p branch)) + (setq branch branch-n)) + (forge--setup-pullreq-remote pullreq) + (forge--setup-pullreq-branch + branch (concat pr-remote "/" pr-branch)) + (if (and (oref pullreq editable-p) + (equal branch pr-branch)) + (magit-set pr-remote "branch" branch "pushRemote") + (magit-set upstream "branch" branch "pushRemote")))) + (when pr-remote + (magit-set pr-remote "branch" branch "pullRequestRemote")) + (magit-set "true" "branch" branch "rebase") + (magit-git "branch" branch + (let ((base-ref (oref pullreq base-ref))) + (concat "--set-upstream-to=" + (if (or magit-branch-prefer-remote-upstream + (not (magit-branch-p base-ref))) + (concat upstream "/" base-ref) + base-ref))))))) + (magit-set (number-to-string number) "branch" branch "pullRequest") + (magit-set (oref pullreq title) "branch" branch "description") + branch)) + +(defun forge--setup-pullreq-branch (branch tracking) + (if (magit-branch-p branch) + (unless (magit-rev-equal branch tracking) + (message "Existing branch %s diverged from %s" branch tracking)) + (magit-git "branch" branch tracking))) + +(defun forge--setup-pullreq-remote (pullreq) + (let* ((pr-remote (oref pullreq head-user)) + (pr-branch (oref pullreq head-ref)) + (repo (forge-get-repository pullreq)) + (host (oref repo githost)) + (user (oref pullreq head-user)) + (fork (oref pullreq head-repo))) + (if (magit-remote-p pr-remote) + (let ((url (magit-git-string "remote" "get-url" pr-remote)) + (fetch (magit-get-all "remote" pr-remote "fetch"))) + (unless (equal (forge--split-forge-url url) + (list host user (substring fork (1+ (length user))))) + (user-error "Remote `%s' already exists but does not point to %s" + pr-remote url)) + (unless (or (member (format "+refs/heads/*:refs/remotes/%s/*" + pr-remote) + fetch) + (member (format "+refs/heads/%s:refs/remotes/%s/%s" + pr-branch pr-remote pr-branch) + fetch)) + (magit-git "remote" "set-branches" "--add" pr-remote pr-branch) + (magit-git "fetch" pr-remote))) + (let ((url (magit-git-string "remote" "get-url" (oref repo remote)))) + (magit-git + "remote" "add" "-f" "--no-tags" + "-t" pr-branch pr-remote + (cond ((or (string-prefix-p "git@" url) + (string-prefix-p "ssh://git@" url)) + (format "git@%s:%s.git" host fork)) + ((string-prefix-p "https://" url) + (format "https://%s/%s.git" host fork)) + ((string-prefix-p "git://" url) + (format "git://%s/%s.git" host fork)) + ((string-prefix-p "http://" url) + (format "http://%s/%s.git" host fork)) + ((error "%s has an unexpected format" url)))))))) + +;;;###autoload +(defun forge-checkout-pullreq (pullreq) + "Create, configure and checkout a new branch from a pull-request. +Please see the manual for more information." + (interactive (list (forge-read-pullreq "Checkout pull request"))) + (magit--checkout (forge--branch-pullreq (forge-get-pullreq pullreq))) + (forge-refresh-buffer)) + +;;;###autoload(autoload 'forge-checkout-this-pullreq "forge-commands" nil t) +(transient-define-suffix forge-checkout-this-pullreq () + "Checkout the current pull-request. +If the branch for that pull-request does not exist yet, then create and +configure it first." + :description "checkout" + :inapt-if-not #'forge-current-pullreq + (interactive) + (forge-checkout-pullreq (forge-current-topic t))) + +;;;###autoload +(defun forge-checkout-worktree (path pullreq) + "Create, configure and checkout a new worktree from a pull-request. +This is like `forge-checkout-pullreq', except that it also +creates a new worktree. Please see the manual for more +information." + (interactive + (let ((id (forge-read-pullreq "Checkout pull request"))) + (list (funcall forge-checkout-worktree-read-directory-function + (forge-get-pullreq id)) + id))) + (when (and (file-exists-p path) + (not (and (file-directory-p path) + (length= (directory-files path) 2)))) + (user-error "%s already exists and isn't empty" path)) + (magit-worktree-checkout path + (forge--branch-pullreq (forge-get-pullreq pullreq)))) + +(defun forge-checkout-worktree-default-read-directory-function (pullreq) + (pcase-let* (((eieio number head-ref) pullreq) + (path (read-directory-name + (format "Checkout #%s in new worktree: " number) + (file-name-directory + (directory-file-name default-directory)) + nil nil + (let ((branch (forge--pullreq-branch-internal pullreq))) + (if (string-match-p "\\`pr-[0-9]+\\'" branch) + (number-to-string number) + (format "%s-%s" number + (string-replace "/" "-" head-ref))))))) + (when (equal path "") + (user-error "The empty string isn't a valid path")) + path)) + +;;; Marks + +(defun forge-create-mark (name face description) + "Define a new mark that topics can be marked with." + (interactive + (list (read-string "Name: ") + (magit-read-char-case "Set appearance using " nil + (?n "a face [n]ame" + (read-face-name "Face name: ")) + (?s "face [s]exp" + (read-from-minibuffer + "Face sexp: " + "(:background \"\" :foreground \"\" :box t)" + read-expression-map t))) + (let ((str (read-string "Description: "))) + (and (not (equal str "")) str)))) + (forge-sql [:insert-into mark :values $v1] + (vector nil (forge--uuid) name face description))) + +(defun forge-edit-mark (id name face description) + "Define a new mark that topics can be marked with." + (interactive + (pcase-let* + ((marks (forge-sql [:select [name id face description] :from mark])) + (`(,name ,id ,face ,description) + (assoc (completing-read "Edit mark" (mapcar #'car marks) nil t) + marks))) + (list id + (read-string "Name: " name) + (magit-read-char-case "Set appearance using " nil + (?n "a face [n]ame" + (read-face-name "Face name: " (and (symbolp face) face))) + (?s "face [s]exp" + (read-from-minibuffer + "Face sexp: " + (if (listp face) + (format "%S" face) + "(:background \"\" :foreground \"\" :box t)") + read-expression-map t))) + (let ((str (read-string "Description: " nil nil description))) + (and (not (equal str "")) str))))) + (forge-sql [:update mark + :set (= [name face description] $v1) + :where (= id $s2)] + (vector name face description) id)) + +;;; Remotely + +;;;###autoload +(defun forge-fork (fork remote) + "Fork the current repository to FORK and add it as a REMOTE. +If the fork already exists, then that isn't an error; the remote +is added anyway. Currently this only supports Github and Gitlab." + (interactive + (let ((fork (magit-completing-read "Fork to" + (mapcar #'car forge-owned-accounts)))) + (list fork + (read-string "Remote name: " + (or (plist-get (cdr (assoc fork forge-owned-accounts)) + 'remote-name) + fork))))) + (let ((repo (forge-get-repository :stub))) + (forge--fork-repository repo fork) + (magit-remote-add remote + (magit-clone--format-url (oref repo githost) fork + (oref repo name)) + (list "--fetch")))) + +;;;###autoload(autoload 'forge-merge "forge-commands" nil t) +(transient-define-suffix forge-merge (pullreq method) + "Merge the current pull-request using METHOD using the forge's API. + +If there is no current pull-request or with a prefix argument, +then read pull-request PULLREQ to visit instead. + +Use of this command is discouraged. Unless the remote repository +is configured to disallow that, you should instead merge locally +and then push the target branch. Forges detect that you have +done that and respond by automatically marking the pull-request +as merged." + (interactive + (list (forge-read-pullreq "Merge pull-request") + (if (forge--childp (forge-get-repository :tracked) + 'forge-gitlab-repository) + (magit-read-char-case "Merge method " t + (?m "[m]erge" 'merge) + (?s "[s]quash" 'squash)) + (magit-read-char-case "Merge method " t + (?m "[m]erge" 'merge) + (?s "[s]quash" 'squash) + (?r "[r]ebase" 'rebase))))) + (let ((pullreq (forge-get-pullreq pullreq))) + (forge--merge-pullreq (forge-get-repository pullreq) + pullreq + (magit-rev-hash + (forge--pullreq-branch-internal pullreq)) + method)) + (forge-pull)) + +;;;###autoload +(defun forge-rename-default-branch () + "Rename the default branch to NEWNAME. +Change the name on the upstream remotely and locally, and update the +upstream remotes of local branches accordingly." + (interactive) + (let* ((repo (forge-get-repository :tracked?)) + (_ (unless (forge-github-repository-p repo) + (user-error "Updating default branch not supported for forge `%s'" + (oref repo forge)))) + (remote (or (and (fboundp 'forge--get-remote) + (forge--get-remote)) + (magit-get-some-remote) + (user-error "No remote configured"))) + (symref (format "refs/remotes/%s/HEAD" remote)) + (oldhead (progn + (message "Determining old default branch...") + (magit-git "fetch" "--prune") + (magit-git "remote" "set-head" "--auto" remote) + (message "Determining old default branch...done") + (magit-git-string "symbolic-ref" "--short" symref))) + (oldname (if oldhead + (cdr (magit-split-branch-name oldhead)) + (error "Cannot determine old default branch"))) + (default (and (not (equal oldname "main")) "main")) + (newname (read-string + (format "Rename default branch `%s' to%s: " + oldname + (if default (format " (default: %s)" default) "")) + nil nil default))) + (message "Renaming default branch...") + (forge--set-default-branch repo newname oldname) + (forge-refresh-buffer) + (message "Renaming default branch...done"))) + +;;; Configuration + +(transient-define-suffix forge-forge.remote () + "Change the local value of the `forge.remote' Git variable." + :class 'magit--git-variable:choices + :variable "forge.remote" + :choices #'magit-list-remotes + :default (lambda (_) (forge--get-remote t t)) + (interactive) + (let ((obj (transient-suffix-object))) + (transient-infix-set obj (transient-infix-read obj))) + (if (and transient--prefix + (eq (oref transient--prefix command) 'forge-add-repository)) + ;; Improvements to Transient will make this hack unnecessary. + (let ((scope (forge-add-repository--scope))) + (oset (transient-prefix-object) scope scope)) + (transient--show))) + +(transient-define-infix forge-forge.graphqlItemLimit () + "Change the maximum number of GraphQL entities to pull at once." + :if #'forge--get-github-repository + :class 'magit--git-variable + :variable "forge.graphqlItemLimit" + :reader #'read-string + :default (lambda () (number-to-string ghub-graphql-items-per-request))) + +(transient-define-suffix forge-toggle-display-in-status-buffer () + "Toggle whether to display topics in the current status buffer." + :if-mode 'magit-status-mode + :inapt-if-not #'forge--buffer-with-topics-sections-p + :description (lambda () + (if (and forge--buffer-topics-spec + (oref forge--buffer-topics-spec type)) + "hide topics" + "display topics")) + (interactive) + (oset forge--buffer-topics-spec type + (if (oref forge--buffer-topics-spec type) nil 'topic)) + (forge-refresh-buffer)) + +(defun forge--buffer-with-topics-sections-p () + (and forge--buffer-topics-spec + (not (eq major-mode 'forge-topics-mode)) + (forge-get-repository :tracked?))) + +;;;###autoload(autoload 'forge-add-pullreq-refspec "forge-commands" nil t) +(transient-define-suffix forge-add-pullreq-refspec () + "Configure Git to fetch all pull-requests. +This is done by adding \"+refs/pull/*/head:refs/pullreqs/*\" +to the value of `remote.REMOTE.fetch', where REMOTE is the +upstream remote." + :if-not 'forge--pullreq-refspec + :description "add pull-request refspec" + (interactive) + (let* ((repo (forge-get-repository :stub)) + (remote (oref repo remote)) + (fetch (magit-get-all "remote" remote "fetch")) + (refspec (oref repo pullreq-refspec))) + (if (member refspec fetch) + (message "Pull-request refspec is already active") + (magit-call-git "config" "--add" + (format "remote.%s.fetch" remote) + refspec) + (magit-git-fetch remote (magit-fetch-arguments))))) + +(defun forge--pullreq-refspec () + (let* ((repo (forge-get-repository :stub)) + (remote (oref repo remote)) + (fetch (magit-get-all "remote" remote "fetch")) + (refspec (oref repo pullreq-refspec))) + (car (member refspec fetch)))) + +;;; Add repositories + +;;;###autoload(autoload 'forge-add-repository "forge-commands" nil t) +(transient-define-prefix forge-add-repository (&optional repo limit) + "Add a repository to the database." + :refresh-suffixes t + [:class transient-subgroups + + ;; Already tracked. + [:if (lambda () (forge--scope :tracked)) + (:info* + (lambda () + (format + (propertize "%s is already being tracked" 'face 'transient-heading) + (propertize (forge--scope 'url) 'face 'bold))) + :format "%d")] + + ;; Nothing to tracked. + [:if-not (lambda () (forge--scope 'topdir)) + (:info* + (lambda () + (format + (propertize "%s is not inside a Git repository" 'face 'transient-heading) + (propertize default-directory 'face 'bold))) + :format "%d")] + + ;; Cannot track. + [:if (lambda () (and (not (forge--scope 'repo)) (forge--scope 'topdir))) + :description + (lambda () + (concat + (format (propertize "Cannot determine forge host for %s\n" + 'face 'transient-heading) + (propertize (forge--scope 'topdir) 'face 'bold)) + (if-let* ((remote (forge--get-remote)) + (url (magit-git-string "remote" "get-url" remote))) + (format (propertize "because %s is not on a host known to Forge." + 'face 'transient-heading) + (propertize url 'face 'bold)) + (propertize "because no suitable remote was detected." + 'face 'transient-heading)))) + ("r" forge-forge.remote :format " %k Try another %d %v" :face 'bold) + ("h" "Learn how to configure another Github host" + (lambda () (interactive) (info "(forge)Setup for Another Github Instance"))) + ("l" "Learn how to configure another Gitlab host" + (lambda () (interactive) (info "(forge)Setup for Another Gitlab Instance"))) + ("p" "Learn how to configure partially supported host" + (lambda () (interactive) (info "(forge)Setup a Partially Supported Host")))] + + ;; Track it! + [:if (lambda () (forge--scope :untracked)) + :description + (lambda () + (format + (propertize "Adding %s to database," 'face 'transient-heading) + (propertize (forge--scope 'url) 'face 'bold))) + ("r" forge-forge.remote :format " %k from %d %v," :face 'bold) + ("a" "pulling all topics" + (lambda (repo) + (interactive (list (forge--scope 'repo))) + (forge-add-repository repo))) + ("s" "pulling only topics since " + (lambda (repo date) + (interactive + (list (forge--scope 'repo) + (forge-read-date "Limit pulling to topics updated since: "))) + (forge-add-repository repo date))) + ("i" "to allow pulling of individual topics" + (lambda (repo) + (interactive (list (forge--scope 'repo))) + (forge-add-repository repo :selective)))] + + ;; Pivot. + [("o" "Add another repository" forge-add-some-repository) + (7 "U" "Add all source repositories belonging to a user" + forge-add-user-repositories) + (7 "O" "Add all source repositories belonging to an organization" + forge-add-organization-repositories)]] + (declare (interactive-only nil)) + (interactive) + (cond + ((not repo) + (transient-setup 'forge-add-repository nil nil + :scope (forge-add-repository--scope))) + ((stringp repo) + (transient-setup 'forge-add-repository nil nil + :scope (forge-add-repository--scope repo))) + (t + (when-let* + (((not (eq limit :selective))) + ((magit-git-config-p "forge.autoPull" t)) + (remote (oref repo remote)) + (refspec (oref repo pullreq-refspec)) + (default-directory (forge-get-worktree repo)) + ((and (not (member refspec (magit-get-all "remote" remote "fetch"))) + (or (eq forge-add-pullreq-refspec t) + (and (eq forge-add-pullreq-refspec 'ask) + (y-or-n-p (format "Also add %S refspec? " refspec))))))) + (magit-call-git "config" "--add" + (format "remote.%s.fetch" remote) + refspec)) + (setq repo (forge-get-repository repo nil :insert!)) + (when (eq limit :selective) + (oset repo selective-p t) + (setq limit nil)) + (forge--pull repo + (and (not (forge-get-worktree repo)) #'ignore) + limit)))) + +(defun forge-add-repository--scope (&optional directory) + (let* ((repo (if directory + (forge-get-repository directory nil :stub?) + (forge-get-repository :stub?))) + (wtree (and repo (forge-get-worktree repo))) + (condition (and repo (oref repo condition))) + (val + `((repo . ,repo) + (wtree . ,wtree) + (condition . ,condition) + (:tracked . ,(eq condition :tracked)) + (:untracked . ,(memq condition '(:known :stub))) + (topdir . ,(or wtree (magit-toplevel))) + (url . ,(and repo (forge-get-url repo)))))) + val)) + +(defun forge--scope (&optional key) + ;; `transient-scope' itself probably offer optional KEY. + (let ((scope (transient-scope))) + (if key (alist-get key scope) scope))) + +(defun forge-add-some-repository (url) + "Read a repository and add it to the database." + (interactive + (let (ret url) + (while (not ret) + (setq url (magit-read-string-ns + "Add repository to database (url, owner/name, or name)" url)) + (unless (string-match-p "\\(://\\|@\\)" url) + (setq url (magit-clone--name-to-url url))) + (cond ((forge-get-repository url nil :tracked?) + (message "%s is already being tracked locally" + (propertize url 'face 'bold)) + (sit-for 3)) + ((not (forge-get-repository url nil :valid?)) + (message "%s does not exist or is inaccessible" + (propertize url 'face 'bold)) + (sit-for 3)) + ((setq ret url)))) + (list ret))) + (forge-add-repository url)) + +;;;###autoload +(defun forge-add-user-repositories (host user) + "Add all of USER's repositories from HOST to the database. +This may take a while. Only Github is supported at the moment." + (interactive + (list (forge-read-host "Add repositories from Github host" + 'forge-github-repository) + (read-string "User: "))) + (forge--add-user-repos 'forge-github-repository host user)) + +;;;###autoload +(defun forge-add-organization-repositories (host organization) + "Add all of ORGANIZATION's repositories from HOST to the database. +This may take a while. Only Github is supported at the moment." + (interactive + (list (forge-read-host "Add repositories from Github host" + 'forge-github-repository) + (read-string "Organization: "))) + (forge--add-organization-repos 'forge-github-repository host organization)) + +;;; Cleanup + +;;;###autoload +(defun forge-remove-repository (repository) + "Remove a repository from the database." + (interactive + (pcase-let* ((repo (forge-read-repository "Remove repository from db")) + ((eieio githost owner name) repo)) + (if (yes-or-no-p (format "Do you really want to remove \"%s/%s @%s\" %s? " + owner name githost "from the database")) + (list repo) + (user-error "Abort")))) + (closql-delete repository) + (forge-refresh-buffer)) + +;;;###autoload +(defun forge-remove-topic-locally (topic) + "Remove a topic from the local database only. +Due to how the supported APIs work, it would be too expensive to +automatically remove topics from the local database that were +removed from the forge. The purpose of this command is to allow +you to manually clean up the local database." + (interactive (list (forge-read-topic "Delete topic LOCALLY only"))) + (setq topic (forge-get-topic topic)) + (closql-delete topic) + (if (and (derived-mode-p 'forge-topic-mode) + (eq (oref topic id) + (oref forge-buffer-topic id))) + (kill-buffer (current-buffer)) + (forge-refresh-buffer))) + +;;;###autoload +(defun forge-reset-database () + "Move the current database file to the trash. +This is useful after the database scheme has changed, which will +happen a few times while the forge functionality is still under +heavy development." + (interactive) + (when (and (file-exists-p forge-database-file) + (yes-or-no-p "Really trash Forge's database file? ")) + (when-let ((db (forge-db t))) + (emacsql-close db)) + (delete-file forge-database-file t) + (forge-refresh-buffer))) + +;;; Miscellaneous + +(magit-define-section-jumper forge-jump-to-pullreqs "Pull requests" pullreqs) +(magit-define-section-jumper forge-jump-to-issues "Issues" issues) + +;;; _ +(provide 'forge-commands) +;;; forge-commands.el ends here diff --git a/elpa/forge-20241218.2036/forge-core.el b/elpa/forge-20241218.2036/forge-core.el new file mode 100644 index 00000000..3c88494a --- /dev/null +++ b/elpa/forge-20241218.2036/forge-core.el @@ -0,0 +1,413 @@ +;;; 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 divided into two +subgroups: `:tracked' and \"untracked\" repositories. + +A `:tracked' repository was previously explicitly added to the database +by the user. + +When Forge encounters a repository, without being instructed by the user +to track it, it may nevertheless add limited information about it to the +database. Such a repository is `:known' but it is not `:tracked'. + +Other repositories are \"unknown\". Most commands can only deal with +repositories that are stored in the database. Of these, some can deal +with any `:known' repositories, others require that they are `:tracked'. + +Some other commands exist — such as the browse commands — that have no +such requirement. While such commands also require a repository object, +they do not care whether that is stored in the database. Instead they +are happy to use a `:stub' repository; a repository that is not stored +in the database. + +The DEMAND argument specifies what kind of repository object the caller +requires, at least. `:tracked' is greater than `:known', which is +greater than `:stub'. For example, if the caller requests a `:known' +repository, a `:tracked' repository will do, while a `:stub' repository +will not. + +The valid values for DEMAND are: + +- `:tracked' and `:tracked?' request a repository that the user added + to the database. If there is no such repository, the former causes + an error to be signaled, while for the latter nil is returned. + +- `:known?' and `:insert!' request a repository from the database. + Whether the user explicitly added it does not matter. If there is no + such repository, nil is returned for the former, while for the latter + a new repository is inserted into the repository and then returned. + +- `:stub' and `:stub?' request the Forge repository corresponding to + the current Git repository. It does not matter whether it is known. + This fails if `default-directory' is not inside a Git repository, if + there is no matching entry in `forge-alist', or if it is unclear which + remote to use. If the repository cannot be determined, the former + causes an error to be signaled, while for the latter nil is returned. + + Stub repository objects are created without making an API request, so + we lack access to the upstream ID, which the IDs used in out database, + derive from. Stub repositories are \"unknown\" in the sense that their + IDs are not `:known'. This is done to allow offline operations. + +- `:valid?' requests the Forge repository corresponding to the current + Git repository. It does not matter whether it is known. If it is + unknown, an API request is made to verify that the repository exists + on the forge. If it does, an object with a valid upstream ID is + returned, but that isn't inserted into the database. If not, nil is + returned. + +Given a repository object, you can query its `condition' slot to learn +whether it is `:tracked', `:known' (i.e., has a valid ID and is stored +in the database), or merely a `:stub'. + +You can also use (forge-get repository OBJECT nil DEMAND) to check the +condition of a repository object, or even to ensure a repository object +has a valid upstream ID (using `:valid?'), or that it is tracked in the +database (using `:insert!'). + +Use `forge-repository-equal' to check if two objects refer to the same +repository. + +Also see info node `(forge) Repository Detection'.") + +(cl-defgeneric forge-get-topic () + "Return a forge issue or pullreq object.") + +(cl-defgeneric forge-get-issue () + "Return a forge issue object.") + +(cl-defgeneric forge-get-pullreq () + "Return a forge pullreq object.") + +(defun forge--get-forge-host (host &optional demand) + "Return `forge-alist' entry matching HOST. + +Entries have the form (GITHOST APIHOST WEBHOST CLASS). + +- If HOST matches a GITHOST, return the corresponding entry. +- Else, if HOST is an ssh alias and the canonical hostname matches a + GITHOST, return the corresponding entry. +- Finally, if HOST matches a WEBHOST, return the corresponding entry. + +If no entry matches, return nil, or signal an error if optional DEMAND +is non-nil." + (or (assoc host forge-alist) + (assoc (seq-some (lambda (line) + (and (string-prefix-p "hostname" line) + (substring line 9))) + (ignore-errors + (process-lines-ignore-status "ssh" "-G" host))) + forge-alist) + (car (cl-member host forge-alist :test #'equal :key #'caddr)) + (and demand + (error "No entry for \"%s\" in `forge-alist'" host)))) + +(defun forge--split-forge-url (url &optional relax) + (save-match-data + (cond + ((string-match + (concat "\\`" + "\\(?:git://\\|" + "[^/@]+@\\|" + "\\(?:ssh\\|ssh\\+git\\|git\\+ssh\\)://\\(?:[^/@]+@\\)?\\|" + "https?://\\(?:[^/@]+@\\)?\\)?" + (if relax + "\\(?1:[^:/]+\\)" + (regexp-opt (mapcar #'car forge-alist) t)) + "\\(?::[0-9]+\\)?" + "\\(?:/\\|:/?\\)" + "~?\\(?2:.+?\\)/" + "\\(?3:[^/]+?\\)" + "\\(?:\\.git\\|/\\)?" + "\\'") + url) + (and-let* ((elt (forge--get-forge-host (match-string 1 url) (not relax)))) + ;; Return the WEBHOST (not the GITHOST, URLs passed to this + ;; function usually contain a GITHOST) because the IDs used to + ;; identify a repository in the database are based on WEBHOSTs. + (list (caddr elt) + (match-string 2 url) + (match-string 3 url)))) + ((not relax) + ;; The host part didn't match any GITHOST in `forge-alist', but it + ;; might be a ssh host alias. We have to relax strictness; in the + ;; extremely unlikely case that there is a common path between the + ;; HOST and the OWNER for this forge, we would incorrectly end up + ;; making that path part of the owner. + (forge--split-forge-url url t))))) + +;;; Identity + +(cl-defgeneric forge--object-id (class &rest args) + "Return the database id for the CLASS object specified by ARGS.") + +(cl-defgeneric forge--repository-ids ( class host owner name + &optional stub noerror) + "Return the database and forge ids for the specified CLASS object.") + +(cl-defmethod magit-section-ident-value ((obj forge-object)) + "Return the value ob OBJ's `id' slot. +Using OBJ itself would not be appropriate because multiple +non-equal objects may exist, representing the same thing." + (oref obj id)) + +(defun forge--set-id-slot (repo object slot rows) + "Set the value in OBJECT for SLOT to VALUE, actually storing foreign keys." + ;; TODO Should CloSQL advice `oset' to make this unnecessary? + (let ((repo-id (oref repo id))) + (closql-oset + object slot + (mapcar (lambda (val) + (forge--object-id repo-id + (if (atom val) val (alist-get 'id val)))) + rows)))) + +;;; Format + +(cl-defgeneric forge--format (object slot &optional spec) + "Return a string based on SPEC and the format-string in OBJECT's SLOT. +The available `format'-like specs depend on the type of OBJECT. +SPEC can be used to add additional specs, as for `format-spec'. +The latter override the former. SLOT is expected to be class- +allocated. Some methods also accept a format string in place +of SLOT.") + +(cl-defmethod forge--format-resource ((object forge-object) resource) + "Return an API resource based on RESOURCE and slots of OBJECT. +For use in `forge--FORGE-METHOD' such as `forge--ghub-get'. +RESOURCE is a string separated by slashes. Each part that begins +with a colon is replaced with a value from OBJECT. `:repo' is a +synonym for `:name'. `:project' is a like `:owner/:name', but the +slash is quoted on Gitlab. `:topic' is a synonym for `:number' +but only if OBJECT is a topic. Any other `:SLOT' means to use +the value of that slot in OBJECT, or if that doesn't exist in its +parent object (determined using `forge-get-parent')." + (save-match-data + (setq resource + (replace-regexp-in-string + ":\\([^/]+\\)" + (lambda (str) + (let ((slot (intern (substring str 1)))) + (or (and-let* + ((v (ignore-errors + (pcase slot + ('repo (oref object name)) + ('project (concat (string-replace + "/" "%2F" (oref object owner)) + "%2F" + (oref object name))) + ('topic (and (forge--childp object 'forge-topic) + (oref object number))) + (_ (eieio-oref object slot)))))) + (format "%s" v)) + str))) + resource t t)) + (if (string-match ":[^/]*" resource) + (if-let ((parent (ignore-errors (forge-get-parent object)))) + (forge--format-resource parent resource) + (error "Cannot resolve %s for a %s" + (match-string 0 resource) + (eieio-object-class object))) + resource))) + +;;; Miscellaneous + +(defun forge-refresh-buffer (&optional buffer) + "Refresh the current buffer, if it is a Magit or Forge buffer. +Refresh the buffer if its major-mode derives from `magit-mode' +or `forge-repository-list-mode'. If optional BUFFER is non-nil, +then refresh that buffer, provided it is alive and satisfies +the mode requirement." + (interactive) + (cond (buffer + (when (buffer-live-p buffer) + (with-current-buffer buffer + (forge-refresh-buffer)))) + ((derived-mode-p 'forge-topic-mode) + (magit-refresh-buffer)) + ((derived-mode-p 'magit-mode) + (magit-refresh-buffer)) + ((and (derived-mode-p 'forge-topic-mode) + (boundp 'forge--buffer-topics-spec) + (oref forge--buffer-topics-spec global)) + (revert-buffer)) + ((derived-mode-p 'forge-repository-list-mode) + (revert-buffer)))) + +(defun forge--sanitize-string (string) + ;; For Gitlab this may also be nil. + (if string (string-replace "\r\n" "\n" string) "")) + +(defun forge--uuid () + "Return string with random (version 4) UUID." + ;; This is a copy of `org-id-uuid'. + ;; Only used in `forge-create-mark'. + (let ((rnd (md5 (format "%s%s%s%s%s%s%s" + (random) + (current-time) + (user-uid) + (emacs-pid) + (user-full-name) + user-mail-address + (recent-keys))))) + (format "%s-%s-4%s-%s%s-%s" + (substring rnd 0 8) + (substring rnd 8 12) + (substring rnd 13 16) + (format "%x" + (logior + #b10000000 + (logand + #b10111111 + (string-to-number + (substring rnd 16 18) 16)))) + (substring rnd 18 20) + (substring rnd 20 32)))) + +;;; _ +(provide 'forge-core) +;;; forge-core.el ends here diff --git a/elpa/forge-20241218.2036/forge-db.el b/elpa/forge-20241218.2036/forge-db.el new file mode 100644 index 00000000..47d132d7 --- /dev/null +++ b/elpa/forge-20241218.2036/forge-db.el @@ -0,0 +1,552 @@ +;;; 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-sql-cdr (sql &rest args) + (mapcar #'cdr (apply #'forge-sql sql args))) + +(defun forge-connect-database-once () + "Try to connect Forge database on first use of `magit-status' only." + (remove-hook 'magit-status-mode-hook #'forge-connect-database-once) + (forge-db)) +(add-hook 'magit-status-mode-hook #'forge-connect-database-once) + +(defun forge-enable-sql-logging () + "Enable logging Forge's SQL queries." + (interactive) + (let ((conn (oref (forge-db) connection))) + (emacsql-enable-debugging conn) + (switch-to-buffer-other-window (oref conn log-buffer)))) + +;;; Schemata + +(defconst forge--db-table-schemata + '((repository + [(class :not-null) + (id :not-null :primary-key) + forge-id + forge + owner + name + apihost + githost + remote + condition + created + updated + pushed + parent + description + homepage + default-branch + archived-p + fork-p + locked-p + mirror-p + private-p + issues-p + wiki-p + stars + watchers + (assignees :default eieio-unbound) + (forks :default eieio-unbound) + (issues :default eieio-unbound) + (labels :default eieio-unbound) + (revnotes :default eieio-unbound) + (pullreqs :default eieio-unbound) + selective-p + worktree + (milestones :default eieio-unbound) + issues-until + pullreqs-until + ]) + + (assignee + [(repository :not-null) + (id :not-null :primary-key) + login + name + forge-id] ; Needed for Gitlab. + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (fork + [(parent :not-null) + (id :not-null :primary-key) + owner + name] + (:foreign-key + [parent] :references repository [id] + :on-delete :cascade)) + + (issue + [(class :not-null) + (id :not-null :primary-key) + repository + number + state + author + title + created + updated + closed + status + locked-p + milestone + body + (assignees :default eieio-unbound) + (cards :default eieio-unbound) + (edits :default eieio-unbound) + (labels :default eieio-unbound) + (participants :default eieio-unbound) + (posts :default eieio-unbound) + (reactions :default eieio-unbound) + (timeline :default eieio-unbound) + (marks :default eieio-unbound) + note + their-id + slug + saved-p] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (issue-assignee + [(issue :not-null) + (id :not-null)] + (:foreign-key + [issue] :references issue [id] + :on-delete :cascade)) + + (issue-label + [(issue :not-null) + (id :not-null)] + (:foreign-key + [issue] :references issue [id] + :on-delete :cascade) + (:foreign-key + [id] :references label [id] + :on-delete :cascade)) + + (issue-mark + [(issue :not-null) + (id :not-null)] + (:foreign-key + [issue] :references issue [id] + :on-delete :cascade) + (:foreign-key + [id] :references mark [id] + :on-delete :cascade)) + + (issue-post + [(class :not-null) + (id :not-null :primary-key) + issue + number + author + created + updated + body + (edits :default eieio-unbound) + (reactions :default eieio-unbound)] + (:foreign-key + [issue] :references issue [id] + :on-delete :cascade)) + + (label + [(repository :not-null) + (id :not-null :primary-key) + name + color + description] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (mark + [;; For now this is always nil because it seems more useful to + ;; share marks between repositories. We cannot omit this slot + ;; though because `closql--iref' expects `id' to be the second + ;; slot. + repository + (id :not-null :primary-key) + name + face + description]) + + (milestone + [(repository :not-null) + (id :not-null :primary-key) + number + title + created + updated + due + closed + description] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (notification + [(class :not-null) + (id :not-null :primary-key) + thread-id + repository + type + topic + url + title + reason + last-read + updated] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (pullreq + [(class :not-null) + (id :not-null :primary-key) + repository + number + state + author + title + created + updated + closed + merged + status + locked-p + editable-p + cross-repo-p + base-ref + base-repo + head-ref + head-user + head-repo + milestone + body + (assignees :default eieio-unbound) + (cards :default eieio-unbound) + (commits :default eieio-unbound) + (edits :default eieio-unbound) + (labels :default eieio-unbound) + (participants :default eieio-unbound) + (posts :default eieio-unbound) + (reactions :default eieio-unbound) + (review-requests :default eieio-unbound) + (reviews :default eieio-unbound) + (timeline :default eieio-unbound) + (marks :default eieio-unbound) + note + base-rev + head-rev + draft-p + their-id + slug + saved-p] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (pullreq-assignee + [(pullreq :not-null) + (id :not-null)] + (:foreign-key + [pullreq] :references pullreq [id] + :on-delete :cascade)) + + (pullreq-label + [(pullreq :not-null) + (id :not-null)] + (:foreign-key + [pullreq] :references pullreq [id] + :on-delete :cascade) + (:foreign-key + [id] :references label [id] + :on-delete :cascade)) + + (pullreq-mark + [(pullreq :not-null) + (id :not-null)] + (:foreign-key + [pullreq] :references pullreq [id] + :on-delete :cascade) + (:foreign-key + [id] :references mark [id] + :on-delete :cascade)) + + (pullreq-post + [(class :not-null) + (id :not-null :primary-key) + pullreq + number + author + created + updated + body + (edits :default eieio-unbound) + (reactions :default eieio-unbound)] + (:foreign-key + [pullreq] :references pullreq [id] + :on-delete :cascade)) + + (pullreq-review-request + [(pullreq :not-null) + (id :not-null)] + (:foreign-key + [pullreq] :references pullreq [id] + :on-delete :cascade)) + + (revnote + [(class :not-null) + (id :not-null :primary-key) + repository + commit + file + line + author + body] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)))) + +(cl-defmethod closql--db-update-schema ((db forge-database)) + (let ((code-version (oref-default 'forge-database version)) + (version (closql--db-get-version db))) + (when (< version code-version) + (forge--backup-database db)) + (closql-with-transaction db + (when (= version 2) + (message "Upgrading Forge database from version 2 to 3...") + (emacsql db [:create-table pullreq-review-request $S1] + (cdr (assq 'pullreq-review-request forge--db-table-schemata))) + (closql--db-set-version db (setq version 3)) + (message "Upgrading Forge database from version 2 to 3...done")) + (when (= version 3) + (message "Upgrading Forge database from version 3 to 4...") + (emacsql db [:drop-table notification]) + (pcase-dolist (`(,table . ,schema) forge--db-table-schemata) + (when (memq table '(notification + mark issue-mark pullreq-mark)) + (emacsql db [:create-table $i1 $S2] table schema))) + (emacsql db [:alter-table issue :add-column marks :default $s1] 'eieio-unbound) + (emacsql db [:alter-table pullreq :add-column marks :default $s1] 'eieio-unbound) + (closql--db-set-version db (setq version 4)) + (message "Upgrading Forge database from version 3 to 4...done")) + (when (= version 4) + (message "Upgrading Forge database from version 4 to 5...") + (emacsql db [:alter-table repository :add-column selective-p :default nil]) + (closql--db-set-version db (setq version 5)) + (message "Upgrading Forge database from version 4 to 5...done")) + (when (= version 5) + (message "Upgrading Forge database from version 5 to 6...") + (emacsql db [:alter-table repository :add-column worktree :default nil]) + (closql--db-set-version db (setq version 6)) + (message "Upgrading Forge database from version 5 to 6...done")) + (when (= version 6) + (message "Upgrading Forge database from version 6 to 7...") + (emacsql db [:alter-table issue :add-column note :default nil]) + (emacsql db [:alter-table pullreq :add-column note :default nil]) + (emacsql db [:create-table milestone $S1] + (cdr (assq 'milestone forge--db-table-schemata))) + (emacsql db [:alter-table repository :add-column milestones :default $s1] + 'eieio-unbound) + (pcase-dolist (`(,repo-id ,issue-id ,milestone) + (emacsql db [:select [repository id milestone] + :from issue + :where (notnull milestone)])) + (unless (stringp milestone) + (oset (forge-get-issue issue-id) milestone + (forge--object-id repo-id (cdar milestone))))) + (pcase-dolist (`(,repo-id ,pullreq-id ,milestone) + (emacsql db [:select [repository id milestone] + :from pullreq + :where (notnull milestone)])) + (unless (stringp milestone) + (oset (forge-get-pullreq pullreq-id) milestone + (forge--object-id repo-id (cdar milestone))))) + (closql--db-set-version db (setq version 7)) + (message "Upgrading Forge database from version 6 to 7...done")) + (when (= version 7) + (message "Upgrading Forge database from version 7 to 8...") + (emacsql db [:alter-table pullreq :add-column base-rev :default nil]) + (emacsql db [:alter-table pullreq :add-column head-rev :default nil]) + (emacsql db [:alter-table pullreq :add-column draft-p :default nil]) + (closql--db-set-version db (setq version 8)) + (message "Upgrading Forge database from version 7 to 8...done")) + (when (= version 8) + (message "Upgrading Forge database from version 8 to 9...") + (emacsql db [:alter-table pullreq :add-column their-id :default nil]) + (emacsql db [:alter-table issue :add-column their-id :default nil]) + (closql--db-set-version db (setq version 9)) + (message "Upgrading Forge database from version 8 to 9...done")) + (when (= version 9) + (message "Upgrading Forge database from version 9 to 10...") + (emacsql db [:alter-table pullreq :add-column slug :default nil]) + (emacsql db [:alter-table issue :add-column slug :default nil]) + (pcase-dolist (`(,id ,number ,type) + (emacsql + db + [:select [pullreq:id pullreq:number repository:class] + :from pullreq + :join repository + :on (= pullreq:repository repository:id)])) + (let ((gitlabp (memq type + (append (closql-where-class-in + 'forge-gitlab-repository--eieio-childp) + nil)))) + (emacsql db [:update pullreq :set (= slug $s1) :where (= id $s2)] + (format "%s%s" (if gitlabp "!" "#") number) + id))) + (pcase-dolist (`(,id ,number) + (emacsql db [:select [id number] :from issue])) + (emacsql db [:update issue :set (= slug $s1) :where (= id $s2)] + (format "#%s" number) + id)) + (closql--db-set-version db (setq version 10)) + (message "Upgrading Forge database from version 9 to 10...done")) + (when (= version 10) + (message "Upgrading Forge database from version 10 to 11...") + (emacsql db [:drop-table notification]) + (emacsql db [:create-table notification $S1] + (cdr (assq 'notification forge--db-table-schemata))) + (emacsql db [:alter-table pullreq :rename-column unread-p :to status]) + (emacsql db [:alter-table issue :rename-column unread-p :to status]) + (emacsql db [:alter-table pullreq :add-column saved-p :default nil]) + (emacsql db [:alter-table issue :add-column saved-p :default nil]) + (closql--db-set-version db (setq version 11)) + (message "Upgrading Forge database from version 10 to 11...done")) + (when (= version 11) + (message "Upgrading Forge database from version 11 to 12...") + (emacsql db [:drop-table notification]) + (emacsql db [:create-table notification $S1] + (cdr (assq 'notification forge--db-table-schemata))) + (dolist (id (emacsql db [:select id :from issue :where (= state 'closed)])) + (emacsql db [:update issue :set (= state 'completed) :where (= id $s1)] + id)) + (dolist (id (emacsql db [:select id :from issue :where (isnull status)])) + (emacsql db [:update issue :set (= state 'done) :where (= id $s1)] + id)) + (dolist (id (emacsql db [:select id :from pullreq :where (= state 'closed)])) + (emacsql db [:update pullreq :set (= state 'rejected) :where (= id $s1)] + id)) + (dolist (id (emacsql db [:select id :from pullreq :where (isnull status)])) + (emacsql db [:update pullreq :set (= state 'done) :where (= id $s1)] + id)) + (emacsql db [:alter-table repository :add-column issues-until :default nil]) + (emacsql db [:alter-table repository :add-column pullreqs-until :default nil]) + (closql--db-set-version db (setq version 12)) + (message "Upgrading Forge database from version 11 to 12...done")) + (when (= version 12) + (message "Upgrading Forge database from version 12 to 13...") + (dolist (id (emacsql db [:select id :from repository + :where (isnull issues-until)])) + (emacsql + db [:update repository :set (= issues-until $s1) :where (= id $s2)] + (caar (forge-sql [:select [updated] :from issue + :where (= repository $s1) + :order-by [(desc updated)] + :limit 1] + id)) + id)) + (dolist (id (emacsql db [:select id :from repository + :where (isnull pullreqs-until)])) + (emacsql + db [:update repository :set (= pullreqs-until $s1) :where (= id $s2)] + (caar (forge-sql [:select [updated] :from pullreq + :where (= repository $s1) + :order-by [(desc updated)] + :limit 1] + id)) + id)) + (emacsql db [:alter-table repository :rename-column sparse-p :to condition]) + (pcase-dolist (`(,id ,not-tracked) + (emacsql db [:select [id condition] :from repository])) + (emacsql + db [:update repository :set (= condition $s1) :where (= id $s2)] + (if not-tracked :known :tracked) + id)) + (closql--db-set-version db (setq version 13)) + (message "Upgrading Forge database from version 12 to 13...done")) + ) + (cl-call-next-method))) + +(defun forge--backup-database (db) + (let ((dst (concat (file-name-sans-extension forge-database-file) + (format "-v%s" (caar (emacsql (oref db connection) + [:pragma user-version]))) + (format-time-string "-%Y%m%d-%H%M") + ".sqlite"))) + (message "Copying Forge database to %s..." dst) + (copy-file forge-database-file dst) + (message "Copying Forge database to %s...done" dst))) + +;;; _ +(provide 'forge-db) +;;; forge-db.el ends here diff --git a/elpa/forge-20241218.2036/forge-gitea.el b/elpa/forge-20241218.2036/forge-gitea.el new file mode 100644 index 00000000..a12881fa --- /dev/null +++ b/elpa/forge-20241218.2036/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-20241218.2036/forge-github.el b/elpa/forge-20241218.2036/forge-github.el new file mode 100644 index 00000000..3c673379 --- /dev/null +++ b/elpa/forge-20241218.2036/forge-github.el @@ -0,0 +1,884 @@ +;;; 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 support in the + ;; REST API is abysmal -- forcing us to perform a major rain dance. + (let ((spec (forge--get-forge-host githost t))) + (forge--msg nil t nil "Pulling notifications") + (pcase-let* + ((`(,_ ,apihost ,forge ,_) spec) + (since (forge--ghub-notifications-since forge)) + (notifs + (seq-keep (lambda (data) + ;; Github returns notifications for repositories the + ;; user no longer has access to. Trying to retrieve + ;; information for such repositories leads to errors, + ;; which we suppress. See #164. + (with-demoted-errors "forge--pull-notifications: %S" + (forge--ghub-massage-notification data githost))) + (forge--ghub-get nil "/notifications" + `((all . t) ,@(and since `((since . ,since)))) + :host apihost :unpaginate t))) + ;; Split into multiple requests to reduce risk of timeouts. + (groups (-partition-all 50 notifs)) + (pages (length groups)) + (page 0) + (topics nil)) + (cl-labels + ((cb (&optional data _headers _status _req) + (when data + (setq topics (nconc topics (cdr data)))) + (if groups + (let* ((query (seq-keep #'caddr (pop groups))) + (tries 3) + (errorback nil) + (vacuum (lambda () + (ghub--graphql-vacuum + (cons 'query query) nil #'cb nil + :auth 'forge :host apihost + :errorback errorback)))) + ;; Github also returns notifications for issues + ;; belonging to repositories for which issues + ;; have been disabled. Drop them and try again. + (setq errorback + (lambda (errors _headers _status _req) + (if (zerop tries) + (ghub--signal-error errors) + (cl-decf tries) + (if-let ((notfound + (seq-keep + (lambda (err) + (and (equal (cdr (assq 'type err)) + "NOT_FOUND") + (cadr (assq 'path err)) + (intern (cadr (assq 'path err))))) + (cdr errors)))) + (progn + (setq query (cl-delete-if + (lambda (e) (memq e notfound)) + query :key #'caar)) + (funcall vacuum)) + (ghub--signal-error errors))))) + (cl-incf page) + (forge--msg nil t nil + "Pulling notifications (page %s/%s)" page pages) + (funcall vacuum)) + (forge--msg nil t t "Pulling notifications") + (forge--msg nil t nil "Storing notifications") + (forge--ghub-update-notifications notifs topics (not since)) + (forge--msg nil t t "Storing notifications") + (when callback + (funcall callback))))) + (cb))))) + +(defun forge--ghub-notifications-since (forge) + (caar (forge-sql [:select :distinct [notification:updated] + :from [notification repository] + :where (and (= repository:forge $s1) + (= repository:id notification:repository)) + :order-by [(desc notification:updated)]] + forge))) + +(defun forge--ghub-massage-notification (data githost) + (let-alist data + (let* ((type (intern (downcase .subject.type))) + (type (if (eq type 'pullrequest) 'pullreq type))) + (and (memq type '(pullreq issue)) + (let* ((number (and (string-match "[0-9]*\\'" .subject.url) + (string-to-number (match-string 0 .subject.url)))) + (repo (forge-get-repository + (list githost + .repository.owner.login + .repository.name) + nil :insert!)) + (repoid (oref repo id)) + (owner (oref repo owner)) + (name (oref repo name)) + (id (forge--object-id repoid (string-to-number .id))) + (alias (intern (concat "_" (string-replace "=" "_" id))))) + (list alias id + `((,alias repository) + [(name ,name) + (owner ,owner)] + ,@(cddr + (caddr + (ghub--graphql-prepare-query + ghub-fetch-repository + (if (eq type 'issue) + `(repository issues (issue . ,number)) + `(repository pullRequest (pullRequest . ,number))) + )))) + repo type data)))))) + +(defun forge--ghub-update-notifications (notifs topics initial-pull) + (closql-with-transaction (forge-db) + (pcase-dolist (`(,alias ,id ,_ ,repo ,type ,data) notifs) + (let-alist data + (and-let* + ((topic-data (cdr (cadr (assq alias topics)))) + (topic (funcall (if (eq type 'issue) + #'forge--update-issue + #'forge--update-pullreq) + repo topic-data nil initial-pull)) + (notif (or (forge-get-notification id) + (closql-insert (forge-db) + (forge-notification + :id id + :thread-id .id + :repository (oref repo id) + :type type + :topic (oref topic id) + :url .subject.url))))) + (oset notif title .subject.title) + (oset notif reason (intern (downcase .reason))) + (oset notif last-read .last_read_at) + (oset notif updated .updated_at)))))) + +;;;; Miscellaneous + +(cl-defmethod forge--add-user-repos + ((class (subclass forge-github-repository)) host user) + (forge--fetch-user-repos + class (forge--as-apihost host) user + (apply-partially #'forge--batch-add-callback (forge--as-githost host) user))) + +(cl-defmethod forge--add-organization-repos + ((class (subclass forge-github-repository)) host org) + (forge--fetch-organization-repos + class (forge--as-apihost host) org + (apply-partially #'forge--batch-add-callback (forge--as-githost host) org))) + +(cl-defmethod forge--fetch-user-repos + ((_ (subclass forge-github-repository)) host user callback) + (ghub--graphql-vacuum + '(query (user + [(login $login String!)] + (repositories + [(:edges t) + (ownerAffiliations . (OWNER))] + name))) + `((login . ,user)) + (lambda (d) + (funcall callback + (--map (alist-get 'name it) + (let-alist d .user.repositories)))) + nil :auth 'forge :host host)) + +(cl-defmethod forge--fetch-organization-repos + ((_ (subclass forge-github-repository)) host org callback) + (ghub--graphql-vacuum + '(query (organization + [(login $login String!)] + (repositories [(:edges t)] name))) + `((login . ,org)) + (lambda (d) + (funcall callback + (--map (alist-get 'name it) + (let-alist d .organization.repositories)))) + nil :auth 'forge :host host)) + +(defun forge--batch-add-callback (host owner names) + (let ((repos (mapcan (lambda (name) + (let ((repo (forge-get-repository + (list host owner name) + nil :insert!))) + (and (not (forge-get-repository repo nil :tracked?)) + (list repo)))) + names)) + (cb nil)) + (setq cb (lambda () + (when-let ((repo (pop repos))) + (forge--pull repo cb)))) + (funcall cb))) + +;;; Mutations + +(cl-defmethod forge--submit-create-issue ((_ forge-github-repository) repo) + (let-alist (forge--topic-parse-buffer) + (forge--ghub-post repo "/repos/:owner/:repo/issues" + `((title . , .title) + (body . , .body) + ,@(and .labels (list (cons 'labels .labels))) + ,@(and .assignees (list (cons 'assignees .assignees)))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback)))) + +(cl-defmethod forge--create-pullreq-from-issue ((repo forge-github-repository) + (issue forge-issue) + source target) + (pcase-let* ((`(,base-remote . ,base-branch) + (magit-split-branch-name target)) + (`(,head-remote . ,head-branch) + (magit-split-branch-name source)) + (head-repo (forge-get-repository :stub head-remote))) + (forge--ghub-post repo "/repos/:owner/:repo/pulls" + `((issue . ,(oref issue number)) + (base . ,base-branch) + (head . ,(if (equal head-remote base-remote) + head-branch + (concat (oref head-repo owner) ":" + head-branch))) + (maintainer_can_modify . t)) + :callback (lambda (&rest _) + (closql-delete issue) + (forge-pull)) + :errorback (lambda (&rest _) (forge-pull))))) + +(cl-defmethod forge--submit-create-pullreq ((_ forge-github-repository) repo) + (let-alist (forge--topic-parse-buffer) + (when (and .yaml (local-variable-p 'forge-buffer-draft-p)) + (user-error "Cannot use yaml frontmatter and set `%s' at the same time" + 'forge-buffer-draft-p)) + (pcase-let* ((`(,base-remote . ,base-branch) + (magit-split-branch-name forge--buffer-base-branch)) + (`(,head-remote . ,head-branch) + (magit-split-branch-name forge--buffer-head-branch)) + (head-repo (forge-get-repository :stub head-remote)) + (url-mime-accept-string + ;; Support draft pull-requests. + "application/vnd.github.shadow-cat-preview+json")) + (forge--ghub-post repo "/repos/:owner/:repo/pulls" + `((title . , .title) + (body . , .body) + (base . ,base-branch) + (head . ,(if (equal head-remote base-remote) + head-branch + (concat (oref head-repo owner) ":" + head-branch))) + (draft . ,(if (local-variable-p 'forge-buffer-draft-p) + forge-buffer-draft-p + .draft)) + (maintainer_can_modify . t)) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))))) + +(cl-defmethod forge--submit-create-post ((_ forge-github-repository) topic) + (forge--ghub-post topic "/repos/:owner/:repo/issues/:number/comments" + `((body . ,(string-trim (buffer-string)))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))) + +(cl-defmethod forge--submit-edit-post ((_ forge-github-repository) post) + (forge--ghub-patch post + (cl-typecase post + (forge-pullreq "/repos/:owner/:repo/pulls/:number") + (forge-issue "/repos/:owner/:repo/issues/:number") + (forge-post "/repos/:owner/:repo/issues/comments/:number")) + (if (cl-typep post 'forge-topic) + (let-alist (forge--topic-parse-buffer) + `((title . , .title) + (body . , .body))) + `((body . ,(string-trim (buffer-string))))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))) + +(cl-defmethod forge--set-topic-title + ((_repo forge-github-repository) topic title) + (forge--ghub-patch topic + "/repos/:owner/:repo/issues/:number" + `((title . ,title)) + :callback (forge--set-field-callback topic))) + +(cl-defmethod forge--set-topic-state + ((_repo forge-github-repository) topic state) + (forge--ghub-patch topic + "/repos/:owner/:repo/issues/:number" + (pcase-exhaustive state + ;; Merging isn't done through here. + ('completed '((state . "closed") (state_reason . "completed"))) + ('unplanned '((state . "closed") (state_reason . "not_planned"))) + ('rejected '((state . "closed"))) + ('open '((state . "open")))) + :callback (forge--set-field-callback topic))) + +(cl-defmethod forge--set-topic-draft + ((_repo forge-github-repository) topic value) + (let ((buffer (current-buffer))) + (ghub-graphql + `(mutation (,(if value + 'convertPullRequestToDraft + 'markPullRequestReadyForReview) + [(input $input ,(if value + 'ConvertPullRequestToDraftInput! + 'MarkPullRequestReadyForReviewInput!))] + (pullRequest isDraft))) + `((input (pullRequestId . ,(oref topic their-id)))) + :host (oref (forge-get-repository topic) apihost) + :auth 'forge + :callback (lambda (data &rest _) + (if (assq 'error data) + (ghub--graphql-pp-response data) + (oset topic draft-p value) + (forge-refresh-buffer buffer)))))) + +(cl-defmethod forge--set-topic-milestone + ((repo forge-github-repository) topic milestone) + (forge--ghub-patch topic + "/repos/:owner/:repo/issues/:number" + (if milestone + `((milestone . ,(caar (forge-sql [:select [number] + :from milestone + :where (and (= repository $s1) + (= title $s2))] + (oref repo id) + milestone)))) + `((milestone . :null))) + :callback (forge--set-field-callback topic))) + +(cl-defmethod forge--set-topic-labels + ((_repo forge-github-repository) topic labels) + (funcall (if labels #'forge--ghub-put #'forge--ghub-delete) + topic "/repos/:owner/:repo/issues/:number/labels" nil + :payload labels + :callback (forge--set-field-callback topic))) + +(cl-defmethod forge--set-topic-assignees + ((_repo forge-github-repository) topic assignees) + (let ((value (mapcar #'cadr (oref topic assignees)))) + ;; FIXME Only refresh once. + (when-let ((add (cl-set-difference assignees value :test #'equal))) + (forge--ghub-post topic "/repos/:owner/:repo/issues/:number/assignees" + `((assignees . ,add)) + :callback (forge--set-field-callback topic))) + (when-let ((remove (cl-set-difference value assignees :test #'equal))) + (forge--ghub-delete topic "/repos/:owner/:repo/issues/:number/assignees" + `((assignees . ,remove)) + :callback (forge--set-field-callback topic))))) + +(cl-defmethod forge--set-topic-review-requests + ((_repo forge-github-repository) topic reviewers) + (let ((value (mapcar #'cadr (oref topic review-requests)))) + ;; FIXME Only refresh once. + (when-let ((add (cl-set-difference reviewers value :test #'equal))) + (forge--ghub-post topic + "/repos/:owner/:repo/pulls/:number/requested_reviewers" + `((reviewers . ,add)) + :callback (forge--set-field-callback topic))) + (when-let ((remove (cl-set-difference value reviewers :test #'equal))) + (forge--ghub-delete topic + "/repos/:owner/:repo/pulls/:number/requested_reviewers" + `((reviewers . ,remove)) + :callback (forge--set-field-callback topic))))) + +(cl-defmethod forge--delete-comment + ((_repo forge-github-repository) post) + (forge--ghub-delete post "/repos/:owner/:repo/issues/comments/:number") + (closql-delete post) + (forge-refresh-buffer)) + +(cl-defmethod forge--topic-template-files ((repo forge-github-repository) + (_ (subclass forge-issue))) + (and-let* ((files (magit-revision-files (oref repo default-branch)))) + (let ((case-fold-search t)) + (if-let ((file (--first (string-match-p "\ +\\`\\(\\|docs/\\|\\.github/\\)issue_template\\(\\.[a-zA-Z0-9]+\\)?\\'" it) + files))) + (list file) + (setq files + (--filter (string-match-p "\\`\\.github/ISSUE_TEMPLATE/[^/]*" it) + files)) + (if-let ((conf (cl-find-if + (lambda (f) + (equal (file-name-nondirectory f) "config.yml")) + files))) + (nconc (delete conf files) + (list conf)) + files))))) + +(cl-defmethod forge--topic-template-files ((repo forge-github-repository) + (_ (subclass forge-pullreq))) + (and-let* ((files (magit-revision-files (oref repo default-branch)))) + (let ((case-fold-search t)) + (if-let ((file (--first (string-match-p "\ +\\`\\(\\|docs/\\|\\.github/\\)pull_request_template\\(\\.[a-zA-Z0-9]+\\)?\\'" it) + files))) + (list file) + ;; Unlike for issues, the web interface does not support + ;; multiple pull-request templates. The API does though, + ;; but due to this limitation I doubt many people use them, + ;; so Forge doesn't support them either. + )))) + +(cl-defmethod forge--set-default-branch ((repo forge-github-repository) + newname oldname) + (forge--ghub-post repo + (format "/repos/:owner/:name/branches/%s/rename" oldname) + `((new_name . ,newname))) + (message "Waiting 5 seconds for GitHub to complete rename...") + (sleep-for 5) + (message "Waiting 5 seconds for GitHub to complete rename...done") + (magit-call-git "fetch" "--prune" (oref repo remote)) + (magit--set-default-branch newname oldname)) + +(cl-defmethod forge--fork-repository ((repo forge-github-repository) fork) + (with-slots (owner name) repo + (forge--ghub-post repo + (format "/repos/%s/%s/forks" owner name) + (and (not (equal fork (ghub--username (ghub--host nil)))) + `((organization . ,fork)))) + (ghub-wait (format "/repos/%s/%s" fork name) nil :auth 'forge))) + +(cl-defmethod forge--merge-pullreq ((_repo forge-github-repository) + topic hash method) + (forge--ghub-put topic + "/repos/:owner/:repo/pulls/:number/merge" + `((merge_method . ,(symbol-name method)) + ,@(and hash `((sha . ,hash)))))) + +;;; Wrappers + +(cl-defun forge--ghub-get (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host + callback errorback) + (declare (indent defun)) + (ghub-get (if obj (forge--format-resource obj resource) resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback :errorback errorback)) + +(cl-defun forge--ghub-put (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host + callback errorback) + (declare (indent defun)) + (ghub-put (if obj (forge--format-resource obj resource) resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback :errorback errorback)) + +(cl-defun forge--ghub-post (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (ghub-post (forge--format-resource obj resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback :errorback errorback)) + +(cl-defun forge--ghub-patch (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (ghub-patch (forge--format-resource obj resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback :errorback errorback)) + +(cl-defun forge--ghub-delete (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (ghub-delete (forge--format-resource obj resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback :errorback errorback)) + +;;; _ +(provide 'forge-github) +;;; forge-github.el ends here diff --git a/elpa/forge-20241218.2036/forge-gitlab.el b/elpa/forge-20241218.2036/forge-gitlab.el new file mode 100644 index 00000000..92b1d882 --- /dev/null +++ b/elpa/forge-20241218.2036/forge-gitlab.el @@ -0,0 +1,682 @@ +;;; 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 . ,(oref repo slug)) + (iid . ,(number-to-string (oref topic number))) + (draft . ,value))) + :host (oref (forge-get-repository topic) apihost) + :auth 'forge + :callback (lambda (data &rest _) + (if (assq 'error data) + (ghub--graphql-pp-response data) + (oset topic draft-p value) + (forge-refresh-buffer buffer)))))) + +(cl-defmethod forge--set-topic-labels + ((repo forge-gitlab-repository) topic labels) + (forge--set-topic-field repo topic 'labels + (string-join labels ","))) + +(cl-defmethod forge--set-topic-assignees + ((repo forge-gitlab-repository) topic assignees) + (let ((users (mapcar #'cdr (oref repo assignees)))) + (cl-typecase topic + (forge-pullreq ; Can only be assigned to a single user. + (forge--set-topic-field repo topic 'assignee_id + (or (caddr (assoc (car assignees) users)) + 0))) + (forge-issue + (forge--set-topic-field repo topic 'assignee_ids + (or (--map (caddr (assoc it users)) assignees) + 0)))))) + +(cl-defmethod forge--set-topic-review-requests + ((repo forge-gitlab-repository) topic reviewers) + (let ((users (mapcar #'cdr (oref repo assignees)))) + (forge--set-topic-field repo topic 'reviewer_ids + (or (--map (caddr (assoc it users)) reviewers) + 0)))) + +(cl-defmethod forge--delete-comment + ((_repo forge-gitlab-repository) post) + (forge--glab-delete post + (cl-etypecase post + (forge-pullreq-post + "/projects/:project/merge_requests/:topic/notes/:number") + (forge-issue-post + "/projects/:project/issues/:topic/notes/:number"))) + (closql-delete post) + (forge-refresh-buffer)) + +(cl-defmethod forge--topic-template-files ((repo forge-gitlab-repository) + (_ (subclass forge-issue))) + (--filter (string-match-p "\\`\\.gitlab/issue_templates/.+\\.md\\'" it) + (magit-revision-files (oref repo default-branch)))) + +(cl-defmethod forge--topic-template-files ((repo forge-gitlab-repository) + (_ (subclass forge-pullreq))) + (--filter (string-match-p "\\`\\.gitlab/merge_request_templates/.+\\.md\\'" it) + (magit-revision-files (oref repo default-branch)))) + +(cl-defmethod forge--fork-repository ((repo forge-gitlab-repository) fork) + (with-slots (owner name) repo + (forge--glab-post repo (format "/projects/%s%%2F%s/fork" owner name) + (and (not (equal fork (ghub--username (ghub--host nil)))) + `((namespace . ,fork))) + :noerror t) + (ghub-wait (format "/projects/%s%%2F%s" fork name) + nil :auth 'forge :forge 'gitlab))) + +(cl-defmethod forge--merge-pullreq ((_repo forge-gitlab-repository) + topic hash method) + (forge--glab-put topic + "/projects/:project/merge_requests/:number/merge" + `((squash . ,(eq method 'squash)) + ,@(and hash `((sha . ,hash)))))) + +;;; Wrappers + +(cl-defun forge--glab-get (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (glab-get (if obj (forge--format-resource obj resource) resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback + :errorback (or errorback (and callback t)))) + +(cl-defun forge--glab-put (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (glab-put (if obj (forge--format-resource obj resource) resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback + :errorback (or errorback (and callback t)))) + +(cl-defun forge--glab-post (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (glab-post (forge--format-resource obj resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback + :errorback (or errorback (and callback t)))) + +(cl-defun forge--glab-delete (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (glab-delete (forge--format-resource obj resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback + :errorback (or errorback (and callback t)))) + +;;; _ +(provide 'forge-gitlab) +;;; forge-gitlab.el ends here diff --git a/elpa/forge-20241218.2036/forge-gogs.el b/elpa/forge-20241218.2036/forge-gogs.el new file mode 100644 index 00000000..6f2d372e --- /dev/null +++ b/elpa/forge-20241218.2036/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-20241218.2036/forge-issue.el b/elpa/forge-20241218.2036/forge-issue.el new file mode 100644 index 00000000..e0f69fcc --- /dev/null +++ b/elpa/forge-20241218.2036/forge-issue.el @@ -0,0 +1,224 @@ +;;; 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-tables (issue-assignee assignee)) + (project-cards) ; projectsCards + (edits) ; userContentEdits + (labels :closql-tables (issue-label label)) + (participants) + (posts :closql-class forge-issue-post) + (reactions) + (timeline) + (marks :closql-tables (issue-mark mark)) + (note :initarg :note :initform nil) + (their-id :initarg :their-id) + (slug :initarg :slug) + (saved-p :initarg :saved-p :initform nil) + )) + +(cl-defmethod closql-dref ((obj forge-issue) (_(eql assignees))) + (forge-sql-cdr + [:select assignee:* :from assignee + :join issue-assignee :on (= issue-assignee:id assignee:id) + :where (= issue-assignee:issue $s1) + :order-by [(asc login)]] + (closql--oref obj 'id))) + +(cl-defmethod closql-dref ((obj forge-issue) (_(eql labels))) + (forge-sql-cdr + [:select label:* :from label + :join issue-label :on (= issue-label:id label:id) + :where (= issue-label:issue $s1) + :order-by [(asc name)]] + (closql--oref obj 'id))) + +(cl-defmethod closql-dref ((obj forge-issue) (_(eql marks))) + (forge-sql-cdr + [:select mark:* :from mark + :join issue-mark :on (= issue-mark:id mark:id) + :where (= issue-mark:issue $s1) + :order-by [(asc name)]] + (closql--oref obj 'id))) + +(defclass forge-issue-post (forge-post) + ((closql-table :initform 'issue-post) + (closql-primary-key :initform 'id) + (closql-order-by :initform [(asc number)]) + (closql-foreign-key :initform 'issue) + (closql-class-prefix :initform "forge-issue-") + (id :initarg :id) + (issue :initarg :issue) + (number :initarg :number) + (author :initarg :author) + (created :initarg :created) + (updated :initarg :updated) + (body :initarg :body) + (edits) + (reactions) + )) + +;;; Query +;;;; Get + +(cl-defmethod forge-get-repository ((post forge-issue-post)) + (forge-get-repository (forge-get-issue post))) + +(cl-defmethod forge-get-topic ((post forge-issue-post)) + (forge-get-issue post)) + +(cl-defmethod forge-get-issue ((issue forge-issue)) + issue) + +(cl-defmethod forge-get-issue ((repo forge-repository) number) + (closql-get (forge-db) + (forge--object-id 'forge-issue repo number) + 'forge-issue)) + +(cl-defmethod forge-get-issue ((number integer)) + (and-let* ((repo (forge-get-repository :tracked nil 'notatpt))) + (forge-get-issue repo number))) + +(cl-defmethod forge-get-issue ((id string)) + (closql-get (forge-db) id 'forge-issue)) + +(cl-defmethod forge-get-issue ((post forge-issue-post)) + (closql-get (forge-db) + (oref post issue) + 'forge-issue)) + +;;;; Current + +(defun forge-current-issue (&optional demand) + "Return the issue at point or being visited. +If there is no such issue and DEMAND is non-nil, then signal +an error." + (or (forge-issue-at-point) + (and (forge-issue-p forge-buffer-topic) + forge-buffer-topic) + (and demand (user-error "No current issue")))) + +(defun forge-issue-at-point (&optional demand) + "Return the issue at point. +If there is no such issue and DEMAND is non-nil, then signal +an error." + (or (thing-at-point 'forge-issue) + (magit-section-value-if 'issue) + (and demand (user-error "No issue at point")))) + +(put 'forge-issue 'thing-at-point #'forge-thingatpt--issue) +(defun forge-thingatpt--issue () + (and-let* ((repo (forge--repo-for-thingatpt))) + (and (thing-at-point-looking-at "#\\([0-9]+\\)\\_>") + (forge-get-issue repo (string-to-number (match-string 1)))))) + +;;; Read + +(defun forge-read-issue (prompt) + "Read an active issue with completion using PROMPT. + +Open, unread and pending issues are considered active. +Default to the current issue, even if it isn't active. + +\\While completion is in \ +progress, \\[forge-read-topic-lift-limit] lifts the limit, extending +the completion candidates to include all issues. + +If `forge-limit-topic-choices' is nil, then all candidates +can be selected from the start." + (forge--read-topic prompt + #'forge-current-issue + (forge--topics-spec :type 'issue :active t) + (forge--topics-spec :type 'issue :active nil :state nil))) + +(defun forge-read-open-issue (prompt) + "Read an open issue with completion using PROMPT." + (let* ((current (forge-current-issue)) + (repo (forge-get-repository (or current :tracked))) + (default (and current (forge--format-topic-line current))) + (alist (forge--topic-collection + (forge--list-topics + (forge--topics-spec :type 'issue :state 'open) + repo))) + (choices (mapcar #'car alist)) + (choice (magit-completing-read prompt choices nil t nil nil default))) + (cdr (assoc choice alist)))) + +;;; Insert + +(defvar-keymap forge-issues-section-map + :parent forge-common-map + " " #'forge-browse-issues + " " #'forge-list-issues + " " #'forge-topics-menu + " " #'forge-topic-menu + "C-c C-n" #'forge-create-issue) + +(defvar-keymap forge-issue-section-map + :parent forge-common-map + " " #'forge-visit-this-topic + " " #'forge-topics-menu + " " #'forge-topic-menu) + +(cl-defun forge-insert-issues (&optional (spec nil sspec) heading) + "Insert a list of issues, according to `forge--buffer-topics-spec'. +Optional SPEC can be used to override that filtering specification, +and optional HEADING to change the section heading." + (when-let (((forge-db t)) + (repo (forge-get-repository :tracked?)) + ((oref repo issues-p)) + (spec (if sspec spec (forge--clone-buffer-topics-spec))) + ((memq (oref spec type) '(topic issue)))) + (oset spec type 'issue) + (forge--insert-topics 'issues + (or heading "Issues") + (forge--list-topics spec repo)))) + +;;; _ +(provide 'forge-issue) +;;; forge-issue.el ends here diff --git a/elpa/forge-20241218.2036/forge-notify.el b/elpa/forge-20241218.2036/forge-notify.el new file mode 100644 index 00000000..8f26cf66 --- /dev/null +++ b/elpa/forge-20241218.2036/forge-notify.el @@ -0,0 +1,325 @@ +;;; 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) + +;;; Class + +(defclass forge-notification (forge-object) + ((closql-class-prefix :initform "forge-") + (closql-table :initform 'notification) + (closql-primary-key :initform 'id) + (closql-order-by :initform [(desc id)]) + (id :initarg :id) + (thread-id :initarg :thread-id) + (repository :initarg :repository) + (type :initarg :type) + (topic :initarg :topic) + (url :initarg :url) + (title :initarg :title) + (reason :initarg :reason) + (last-read :initarg :last-read) + (updated :initarg :updated))) + +;;; Query +;;;; Get + +(cl-defmethod forge-get-repository ((notify forge-notification)) + "Return the object for the repository that NOTIFY belongs to." + (and-let* ((id (oref notify repository))) + (closql-get (forge-db) id 'forge-repository))) + +(cl-defmethod forge-get-topic ((notify forge-notification)) + (and-let* ((repo (forge-get-repository notify))) + (forge-get-topic repo (oref notify topic)))) + +(cl-defmethod forge-get-notification ((id string)) + (closql-get (forge-db) id 'forge-notification)) + +(cl-defmethod forge-get-notification ((topic forge-topic)) + (and-let* ((row (car (forge-sql [:select * :from notification + :where (and (= repository $s1) + (= topic $s2))] + (oref topic repository) + (oref topic number))))) + (closql--remake-instance 'forge-notification (forge-db) row))) + +;;;; Current + +(defun forge-current-notification (&optional demand) + "Return the current notification, casting a topic if necessary. +If there is no such notification and DEMAND is non-nil, then +signal an error." + (or (magit-section-value-if 'notification) + (and-let* ((topic (forge-current-topic))) + (forge-get-notification topic)) + (and demand (user-error "No current notification")))) + +(defun forge-notification-at-point (&optional demand) + "Return the notification at point, casting a topic if necessary. +If there is no such notification and DEMAND is non-nil, then +signal an error." + (or (magit-section-value-if 'notification) + (and-let* ((topic (forge-topic-at-point))) + (forge-get-notification topic)) + (and demand (user-error "No notification at point")))) + +;;;; List + +(defun forge--ls-notifications (status) + (let* ((status (ensure-list status)) + (savedp (memq 'saved status)) + (status (remq 'saved status))) + (mapcar + (lambda (row) (closql--remake-instance 'forge-notification (forge-db) row)) + (if (seq-set-equal-p status '(unread pending done) #'eq) + (forge-sql [:select * :from notification :order-by [(desc updated)]]) + (forge-sql + `[:select :distinct notification:* + :from [notification (as issue topic)] + :where (and (= notification:topic topic:id) + ,@(and status '((in topic:status $v1))) + ,@(and savedp '((= topic:saved-p 't)))) + :union + :select :distinct notification:* + :from [notification (as pullreq topic)] + :where (and (= notification:topic topic:id) + ,@(and status '((in topic:status $v1))) + ,@(and savedp '((= topic:saved-p 't)))) + :order-by [(desc notification:updated)]] + (vconcat status)))))) + +;;; Mode + +(defvar-keymap forge-notifications-mode-map + :doc "Keymap for `forge-notifications-mode'." + :parent (make-composed-keymap forge-common-map magit-mode-map) + " " #'magit-refresh-buffer + " " #'forge-notifications-menu) + +(define-derived-mode forge-notifications-mode magit-mode "Forge Notifications" + "Major mode for looking at forge notifications." + :interactive nil + (magit-hack-dir-local-variables)) + +(defun forge-notifications-setup-buffer () + (magit-setup-buffer-internal #'forge-notifications-mode nil + '((default-directory "/") + (forge-buffer-unassociated-p t)) + (get-buffer-create "*forge-notifications*"))) + +(defun forge-notifications-refresh-buffer () + (magit-set-header-line-format (forge-notifications-buffer-desc)) + (forge-insert-notifications)) + +(defun forge-notifications-buffer-desc () + (let ((status forge-notifications-selection)) + (cond + ((not (listp status)) + (format "%s notifications" (capitalize (symbol-name status)))) + ((seq-set-equal-p status '(unread pending)) "Inbox") + ((seq-set-equal-p status '(unread pending done)) "All notifications") + ((format "Notifications %s" status))))) + +(defvar forge-notifications-display-style 'flat) +(defvar forge-notifications-selection '(unread pending)) + +;;; Commands + +(transient-define-prefix forge-notifications-menu () + "Control list of notifications and notification at point." + :transient-suffix t + :transient-non-suffix #'transient--do-call + :transient-switch-frame nil + :refresh-suffixes t + :environment #'forge--menu-environment + :column-widths forge--topic-menus-column-widths + [:hide always ("q" forge-menu-quit-list)] + [forge--topic-menus-group + ["Selection" + ("I" forge-notifications-display-inbox) + ("S" forge-notifications-display-saved) + ("D" forge-notifications-display-done) + ("A" forge-notifications-display-all)]] + [forge--lists-group + ["Display" + ("-F" forge-notifications-style-flat) + ("-G" forge-notifications-style-nested) + ("-H" forge-toggle-topic-legend)]] + [forge--topic-legend-group] + (interactive) + (unless (derived-mode-p 'forge-notifications-mode) + (forge-list-notifications)) + (transient-setup 'forge-notifications-menu)) + +(transient-augment-suffix forge-notifications-menu + :transient #'transient--do-replace + :if-mode 'forge-notifications-mode + :inapt-if (lambda () (eq (oref transient--prefix command) 'forge-notifications-menu)) + :inapt-face 'forge-suffix-active) + +;;;###autoload(autoload 'forge-list-notifications "forge-notify" nil t) +(transient-define-suffix forge-list-notifications () + "List notifications." + :inapt-if-mode 'forge-notifications-mode + :inapt-face 'forge-suffix-active + (declare (interactive-only nil)) + (interactive) + (forge-notifications-setup-buffer) + (transient-setup 'forge-notifications-menu)) + +(transient-define-suffix forge-notifications-display-inbox () + "List unread and pending notifications." + :description "inbox" + :inapt-if (lambda () (equal forge-notifications-selection '(unread pending))) + :inapt-face 'forge-suffix-active + (interactive) + (unless (derived-mode-p 'forge-notifications-mode) + (user-error "Not in notification buffer")) + (setq forge-notifications-selection '(unread pending)) + (forge-refresh-buffer)) + +(transient-define-suffix forge-notifications-display-saved () + "List saved notifications." + :description "saved" + :inapt-if (lambda () (eq forge-notifications-selection 'saved)) + :inapt-face 'forge-suffix-active + (interactive) + (unless (derived-mode-p 'forge-notifications-mode) + (user-error "Not in notification buffer")) + (setq forge-notifications-selection 'saved) + (forge-refresh-buffer)) + +(transient-define-suffix forge-notifications-display-done () + "List done notifications." + :description "done" + :inapt-if (lambda () (eq forge-notifications-selection 'done)) + :inapt-face 'forge-suffix-active + (interactive) + (unless (derived-mode-p 'forge-notifications-mode) + (user-error "Not in notification buffer")) + (setq forge-notifications-selection 'done) + (forge-refresh-buffer)) + +(transient-define-suffix forge-notifications-display-all () + "List all notifications." + :description "all" + :inapt-if (lambda () (equal forge-notifications-selection '(unread pending done))) + :inapt-face 'forge-suffix-active + (interactive) + (unless (derived-mode-p 'forge-notifications-mode) + (user-error "Not in notification buffer")) + (setq forge-notifications-selection '(unread pending done)) + (forge-refresh-buffer)) + +(transient-define-suffix forge-notifications-style-flat () + "Show a flat notification list." + :description "single list" + :inapt-if (lambda () (eq forge-notifications-display-style 'flat)) + :inapt-face 'forge-suffix-active + (interactive) + (unless (derived-mode-p 'forge-notifications-mode) + (user-error "Not in notification buffer")) + (setq forge-notifications-display-style 'flat) + (forge-refresh-buffer)) + +(transient-define-suffix forge-notifications-style-nested () + "Group notifications by repository." + :description "group by repo" + :inapt-if (lambda () (eq forge-notifications-display-style 'nested)) + :inapt-face 'forge-suffix-active + (interactive) + (unless (derived-mode-p 'forge-notifications-mode) + (user-error "Not in notification buffer")) + (setq forge-notifications-display-style 'nested) + (forge-refresh-buffer)) + +;;; Sections + +(defclass forge-repository-section (magit-section) + ((type :initform 'forge-repo) + (keymap :initform 'forge-repository-section-map))) + +(define-obsolete-variable-alias 'forge-forge-repo-section-map + 'forge-repository-section-map "Forge 0.4.0") + +(defvar-keymap forge-repository-section-map + " " #'forge-browse-this-repository + " " #'forge-visit-this-repository) + +(defun forge-insert-notifications () + (let ((notifs (forge--ls-notifications forge-notifications-selection))) + (magit-insert-section (notifications) + (cond + ((not notifs) + (insert "(empty)\n")) + ((eq forge-notifications-display-style 'flat) + (magit-insert-section-body + (dolist (notif notifs) + (forge-insert-notification notif)) + (insert ?\n))) + ((pcase-dolist (`(,_ . ,notifs) + (--group-by (oref it repository) notifs)) + (let ((repo (forge-get-repository (car notifs)))) + (magit-insert-section (forge-repo repo) + (magit-insert-heading + (concat (propertize (oref repo slug) 'font-lock-face 'bold) + (format " (%s)" (length notifs)))) + (magit-insert-section-body + (dolist (notif notifs) + (forge-insert-notification notif)) + (insert ?\n)))))))))) + +(defun forge-insert-notification (notif) + (with-slots (type title url) notif + (pcase type + ((or 'issue 'pullreq) + (forge--insert-topic (forge-get-topic notif))) + ('commit + (magit-insert-section (ncommit nil) ; !commit + (string-match "[^/]*\\'" url) + (insert + (format "%s %s\n" + (propertize (substring (match-string 0 url) + 0 (magit-abbrev-length)) + 'font-lock-face 'magit-hash) + (magit-log-propertize-keywords + nil + (propertize title 'font-lock-face + (if-let ((topic (oref notif topic)) + ((eq (oref topic status) 'unread))) + 'forge-topic-unread + 'forge-topic-open))))))) + (_ + ;; The documentation does not mention what "types" + ;; exist. Make it obvious that this is something + ;; we do not know how to handle properly yet. + (magit-insert-section (notification notif) + (insert (propertize (format "(%s) %s\n" type title) + 'font-lock-face 'error))))))) + +;;; _ +(provide 'forge-notify) +;;; forge-notify.el ends here diff --git a/elpa/forge-20241218.2036/forge-pkg.el b/elpa/forge-20241218.2036/forge-pkg.el new file mode 100644 index 00000000..ba6b2b43 --- /dev/null +++ b/elpa/forge-20241218.2036/forge-pkg.el @@ -0,0 +1,21 @@ +;; -*- no-byte-compile: t; lexical-binding: nil -*- +(define-package "forge" "20241218.2036" + "Access Git forges from Magit." + '((emacs "29.1") + (compat "30.0.0.0") + (closql "2.1.0") + (dash "2.19.1") + (emacsql "4.1.0") + (ghub "4.2.0") + (let-alist "1.0.6") + (magit "4.1.3") + (markdown-mode "2.6") + (seq "2.24") + (transient "0.8.0") + (yaml "0.5.5")) + :url "https://github.com/magit/forge" + :commit "3b80ace32c23c030d8c12dd9bf266962718545cf" + :revdesc "3b80ace32c23" + :keywords '("git" "tools" "vc") + :authors '(("Jonas Bernoulli" . "emacs.forge@jonas.bernoulli.dev")) + :maintainers '(("Jonas Bernoulli" . "emacs.forge@jonas.bernoulli.dev"))) diff --git a/elpa/forge-20241218.2036/forge-post.el b/elpa/forge-20241218.2036/forge-post.el new file mode 100644 index 00000000..23526ead --- /dev/null +++ b/elpa/forge-20241218.2036/forge-post.el @@ -0,0 +1,257 @@ +;;; 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 used to keep track of the draft status +of the current pull-request." + :package-version '(forge . "0.4.0") + :group 'forge + :type 'boolean) + +;;; Class + +(defclass forge-post (forge-object) () :abstract t) + +;;; Query +;;;; Get + +(cl-defmethod forge-get-parent ((post forge-post)) + (forge-get-topic post)) + +(cl-defmethod forge-get-repository ((post forge-post)) + (forge-get-repository (forge-get-topic post))) + +;;;; Current + +(defun forge-post-at-point (&optional assert) + "Return the post at point. +If there is no such post and DEMAND is non-nil, then signal +an error." + (or (magit-section-value-if '(issue pullreq post)) + (and assert (user-error "There is no post at point")))) + +(defun forge-comment-at-point (&optional assert) + "Return the comment at point. +If there is no such comment and DEMAND is non-nil, then signal +an error." + (or (and (magit-section-value-if '(post)) + (let ((post (oref (magit-current-section) value))) + (and (or (forge-pullreq-post-p post) + (forge-issue-post-p post)) + post))) + (and assert (user-error "There is no comment at point")))) + +;;; Utilities + +(cl-defmethod forge--format ((post forge-post) slot &optional spec) + (forge--format (forge-get-topic post) slot + `(,@spec (?I . ,(oref post number))))) + +;;; Mode + +(defvar-keymap forge-post-mode-map + "C-c C-e" #'forge-post-dispatch + "C-c C-c" #'forge-post-submit + " " #'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" + "Major mode for editing topic posts." + :interactive nil) + +(defvar-local forge--buffer-base-branch nil) +(defvar-local forge--buffer-head-branch nil) +(defvar-local forge--buffer-post-object nil) +(defvar-local forge--buffer-issue nil) +(defvar-local forge--submit-post-function nil) +(defvar-local forge--cancel-post-function nil) +(defvar-local forge--pre-post-buffer nil) +(make-variable-buffer-local 'forge-buffer-draft-p) + +(defun forge--prepare-post-buffer (filename &optional header source target) + (let ((file (convert-standard-filename + (expand-file-name (concat "magit/posts/" filename) + (magit-gitdir))))) + (make-directory (file-name-directory file) t) + (let ((prevbuf (current-buffer)) + (resume (and (file-exists-p file) + (> (file-attribute-size (file-attributes file)) 0))) + (buf (find-file-noselect file))) + (with-current-buffer buf + (forge-post-mode) + (when header + (magit-set-header-line-format header)) + (setq forge--pre-post-buffer prevbuf) + (when resume + (forge--display-post-buffer buf) + (when (magit-read-char-case "A draft already exists. " nil + (?r "[r]esume editing existing draft") + (?d "[d]iscard draft and start over" t)) + (erase-buffer) + (setq resume nil))) + (when (and (not resume) (string-prefix-p "new" filename)) + (let-alist (forge--topic-template + (forge-get-repository :tracked) + (if source 'forge-pullreq 'forge-issue)) + (cond + (.url + (browse-url .url) + (forge-post-cancel) + (setq buf nil) + (message "Using browser to visit %s instead of opening an issue" + .url)) + (.name + ;; A Github issue with yaml frontmatter. + (save-excursion (insert .text)) + (unless (re-search-forward "^title: " nil t) + (when (re-search-forward "^---" nil t 2) + (beginning-of-line) + (insert "title: \n") + (backward-char)))) + (t + (insert "# ") + (let ((single + (and source + (= (car (magit-rev-diff-count source target)) 1)))) + (save-excursion + (when single + ;; A pull-request. + (magit-rev-insert-format "%B" source)) + (when .text + (if single + (insert "-------\n") + (insert "\n")) + (insert "\n" .text))))))))) + buf))) + +(defun forge--display-post-buffer (buf) + (magit-display-buffer buf #'display-buffer)) + +(defun forge-post-cancel () + "Cancel the post that is being edited in the current buffer." + (interactive) + (save-buffer) + (if-let ((fn forge--cancel-post-function)) + (funcall fn forge--buffer-post-object) + (magit-mode-bury-buffer 'kill))) + +(defun forge-post-submit () + "Submit the post that is being edited in the current buffer." + (interactive) + (save-buffer) + (if-let ((fn forge--submit-post-function)) + (funcall fn + (forge-get-repository forge--buffer-post-object) + forge--buffer-post-object) + (error "forge--submit-post-function is nil"))) + +(defun forge--post-submit-callback () + (let* ((file buffer-file-name) + (editbuf (current-buffer)) + (prevbuf forge--pre-post-buffer) + (topic (ignore-errors (forge-get-topic forge--buffer-post-object))) + (repo (forge-get-repository topic))) + (lambda (value headers status req) + (run-hook-with-args 'forge-post-submit-callback-hook + value headers status req) + (delete-file file t) + (let ((dir (file-name-directory file))) + (unless (cddr (directory-files dir nil nil t)) + (delete-directory dir nil t))) + (when (buffer-live-p editbuf) + (with-current-buffer editbuf + (magit-mode-bury-buffer 'kill))) + (with-current-buffer + (if (buffer-live-p prevbuf) prevbuf (current-buffer)) + (if (and topic + (forge--childp repo 'forge-github-repository) + (oref repo selective-p)) + (forge--pull-topic repo topic) + (forge-pull)))))) + +(defun forge--post-submit-errorback () + (lambda (error &rest _) + (error "Failed to submit post: %S" error))) + +(transient-define-prefix forge-post-dispatch () + "Dispatch a post creation command." + ["Variables" + ("d" "Create draft" forge-post-toggle-draft)] + ["Act" + ("C-c" "Submit" forge-post-submit) + ("C-k" "Cancel" forge-post-cancel)]) + +(transient-define-infix forge-post-toggle-draft () + "Toggle whether the pull-request being created is a draft." + :class 'transient-lisp-variable + :variable 'forge-buffer-draft-p + :reader (lambda (&rest _) (not forge-buffer-draft-p)) + :if (lambda () (equal (file-name-nondirectory buffer-file-name) "new-pullreq"))) + +;;; Notes + +(defclass forge-note (forge-post) ()) + +(defvar-keymap forge-note-section-map + " " #'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-20241218.2036/forge-pullreq.el b/elpa/forge-20241218.2036/forge-pullreq.el new file mode 100644 index 00000000..0c0c9afd --- /dev/null +++ b/elpa/forge-20241218.2036/forge-pullreq.el @@ -0,0 +1,296 @@ +;;; 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-tables (pullreq-assignee assignee)) + (project-cards) ; projectsCards + (commits) + (edits) ; userContentEdits + (labels :closql-tables (pullreq-label label)) + (participants) + (posts :closql-class forge-pullreq-post) + (reactions) + (review-requests :closql-tables (pullreq-review-request assignee)) + (reviews) + (timeline) + (marks :closql-tables (pullreq-mark mark)) + (note :initarg :note :initform nil) + (base-rev :initarg :base-rev) + (head-rev :initarg :head-rev) + (draft-p :initarg :draft-p) + (their-id :initarg :their-id) + (slug :initarg :slug) + (saved-p :initarg :saved-p :initform nil) + )) + +(cl-defmethod closql-dref ((obj forge-pullreq) (_(eql assignees))) + (forge-sql-cdr + [:select assignee:* :from assignee + :join pullreq-assignee :on (= pullreq-assignee:id assignee:id) + :where (= pullreq-assignee:pullreq $s1) + :order-by [(asc login)]] + (closql--oref obj 'id))) + +(cl-defmethod closql-dref ((obj forge-pullreq) (_(eql labels))) + (forge-sql-cdr + [:select label:* :from label + :join pullreq-label :on (= pullreq-label:id label:id) + :where (= pullreq-label:pullreq $s1) + :order-by [(asc name)]] + (closql--oref obj 'id))) + +(cl-defmethod closql-dref ((obj forge-pullreq) (_(eql review-requests))) + (forge-sql-cdr + [:select assignee:* :from assignee + :join pullreq-review-request :on (= pullreq-review-request:id assignee:id) + :where (= pullreq-review-request:pullreq $s1) + :order-by [(asc login)]] + (closql--oref obj 'id))) + +(cl-defmethod closql-dref ((obj forge-pullreq) (_(eql marks))) + (forge-sql-cdr + [:select mark:* :from mark + :join pullreq-mark :on (= pullreq-mark:id mark:id) + :where (= pullreq-mark:pullreq $s1) + :order-by [(asc name)]] + (closql--oref obj 'id))) + +(defclass forge-pullreq-post (forge-post) + ((closql-table :initform 'pullreq-post) + (closql-primary-key :initform 'id) + (closql-order-by :initform [(asc number)]) + (closql-foreign-key :initform 'pullreq) + (closql-class-prefix :initform "forge-pullreq-") + (id :initarg :id) + (pullreq :initarg :pullreq) + (number :initarg :number) + (author :initarg :author) + (created :initarg :created) + (updated :initarg :updated) + (body :initarg :body) + (edits) + (reactions) + )) + +;;; Query +;;;; Get + +(cl-defmethod forge-get-repository ((post forge-pullreq-post)) + (forge-get-repository (forge-get-pullreq post))) + +(cl-defmethod forge-get-topic ((post forge-pullreq-post)) + (forge-get-pullreq post)) + +(cl-defmethod forge-get-pullreq ((pullreq forge-pullreq)) + pullreq) + +(cl-defmethod forge-get-pullreq ((repo forge-repository) number) + (closql-get (forge-db) + (forge--object-id 'forge-pullreq repo number) + 'forge-pullreq)) + +(cl-defmethod forge-get-pullreq ((number integer)) + (and-let* ((repo (forge-get-repository :tracked nil 'notatpt))) + (forge-get-pullreq repo number))) + +(cl-defmethod forge-get-pullreq ((id string)) + (closql-get (forge-db) id 'forge-pullreq)) + +(cl-defmethod forge-get-pullreq ((post forge-pullreq-post)) + (closql-get (forge-db) + (oref post pullreq) + 'forge-pullreq)) + +(cl-defmethod forge-get-pullreq ((_(eql :branch)) &optional branch) + (and-let* ((branch (or branch + (magit-section-case + (branch (oref it value)) + (commit (magit--painted-branch-at-point))))) + (branch (cdr (magit-split-branch-name branch))) + (number (magit-get "branch" branch "pullRequest"))) + (forge-get-pullreq (string-to-number number)))) + +;;;; Current + +(defun forge-current-pullreq (&optional demand) + "Return the pull-request at point or being visited. +If there is no such pull-request and DEMAND is non-nil, then signal +an error." + (or (forge-pullreq-at-point) + (and (forge-pullreq-p forge-buffer-topic) + forge-buffer-topic) + (and demand (user-error "No current pull-request")))) + +(defun forge-pullreq-at-point (&optional demand) + "Return the pull-request at point. +If there is no such pull-request and DEMAND is non-nil, then signal +an error." + (or (thing-at-point 'forge-pullreq) + (magit-section-value-if 'pullreq) + (forge-get-pullreq :branch) + (and demand (user-error "No pull-request at point")))) + +(put 'forge-pullreq 'thing-at-point #'forge-thingatpt--pullreq) +(defun forge-thingatpt--pullreq () + (and-let* ((repo (forge--repo-for-thingatpt))) + (and (thing-at-point-looking-at + (if (forge-gitlab-repository--eieio-childp repo) + "[#!]\\([0-9]+\\)\\_>" + "#\\([0-9]+\\)\\_>")) + (forge-get-pullreq repo (string-to-number (match-string 1)))))) + +;;; Read + +(defun forge-read-pullreq (prompt) + "Read an active pull-request with completion using PROMPT. + +Open, unread and pending pull-requests are considered active. +Default to the current pull-request, even if it isn't active. + +\\While completion is in \ +progress, \\[forge-read-topic-lift-limit] lifts the limit, extending +the completion candidates to include all pull-requests. + +If `forge-limit-topic-choices' is nil, then all candidates +can be selected from the start." + (forge--read-topic prompt + #'forge-current-pullreq + (forge--topics-spec :type 'pullreq :active t) + (forge--topics-spec :type 'pullreq :active nil :state nil))) + +;;; Utilities + +(defun forge--pullreq-branch-internal (pullreq) + (let ((branch (oref pullreq head-ref))) + ;; It is invalid for a branch name to begin with a colon, yet + ;; that is what Gitlab uses when a pull-request's source branch + ;; has been deleted. On Github this is simply nil in the same + ;; situation. + (and branch (not (string-prefix-p ":" branch)) branch))) + +(defun forge--pullreq-branch-active (pullreq) + (let* ((number (number-to-string (oref pullreq number))) + (branch-n (format "pr-%s" number)) + (branch (forge--pullreq-branch-internal pullreq))) + (or (and (magit-branch-p branch) + (equal (magit-get "branch" branch "pullRequest") number) + branch) + (and (magit-branch-p branch-n) + (equal (magit-get "branch" branch-n "pullRequest") number) + branch-n)))) + +(defun forge--pullreq-ref (pullreq) + (let ((ref (format "refs/pullreqs/%s" (oref pullreq number)))) + (and (magit-rev-verify ref) ref))) + +(defun forge--pullreq-range (pullreq &optional endpoints) + (and-let* ((head (forge--pullreq-ref pullreq))) + (concat (forge--get-remote) "/" (oref pullreq base-ref) + (if endpoints "..." "..") + head))) + +;;; Insert + +(defvar-keymap forge-pullreqs-section-map + :parent forge-common-map + " " #'forge-browse-pullreqs + " " #'forge-list-pullreqs + " " #'forge-topics-menu + " " #'forge-topic-menu + "C-c C-n" #'forge-create-pullreq) + +(defvar-keymap forge-pullreq-section-map + :parent forge-common-map + " " #'forge-visit-this-topic + " " #'forge-topics-menu + " " #'forge-topic-menu) + +(cl-defun forge-insert-pullreqs (&optional (spec nil sspec) heading) + "Insert a list of pull-requests, according to `forge--buffer-topics-spec'. +Optional SPEC can be used to override that filtering specification, +and optional HEADING to change the section heading." + (when-let (((forge-db t)) + (repo (forge-get-repository :tracked?)) + (spec (if sspec spec (forge--clone-buffer-topics-spec))) + ((memq (oref spec type) '(topic pullreq)))) + (oset spec type 'pullreq) + (forge--insert-topics 'pullreqs + (or heading "Pull requests") + (forge--list-topics spec repo)))) + +(defun forge--insert-pullreq-commits (pullreq &optional all) + (cl-letf (((symbol-function #'magit-cancel-section) (lambda ()))) + (if all + ;; Numeric pr ref, pr branch (if it exists) and api + ;; pr range may be out of sync. Just show them all. + (magit-insert-section-body + (magit--insert-log nil + (delq nil (list (concat "^" (or (oref pullreq base-rev) + (concat (forge--get-remote) "/" + (oref pullreq base-ref)))) + (forge--pullreq-ref pullreq) + (forge--pullreq-branch-active pullreq) + (and-let* ((branch (oref pullreq head-ref))) + (and (magit-local-branch-p branch) branch)))) + (seq-uniq (cons "--graph" magit-buffer-log-args)))) + (when-let ((range (forge--pullreq-range pullreq))) + (magit-insert-section-body + (magit--insert-log nil range magit-buffer-log-args) + (magit-make-margin-overlay nil t)))))) + +;;; _ +(provide 'forge-pullreq) +;;; forge-pullreq.el ends here diff --git a/elpa/forge-20241218.2036/forge-repo.el b/elpa/forge-20241218.2036/forge-repo.el new file mode 100644 index 00000000..47791f55 --- /dev/null +++ b/elpa/forge-20241218.2036/forge-repo.el @@ -0,0 +1,544 @@ +;;; 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 ignore-variable) + (let* ((remotes (magit-list-remotes)) + (config (and (not ignore-variable) + (magit-get "forge.remote"))) + (remote (if (cdr remotes) + (or (car (member config remotes)) + (car (member "upstream" remotes)) + (car (member "origin" remotes))) + (car remotes)))) + (when (and warn config remote (not (equal config remote))) + (message "Ignored forge.remote=%s; no such remote.\nSee %s." config + "https://magit.vc/manual/forge/How-Forge-Detection-Works.html")) + remote)) + +(cl-defmethod forge-get-repository ((_(eql :id)) id) + (closql-get (forge-db) (substring-no-properties id) 'forge-repository)) + +(cl-defmethod forge-get-repository ((_(eql :dir)) dir) + (let ((default-directory dir) + (forge-buffer-repository nil) + (forge-buffer-topic nil)) + (forge-get-repository :stub? nil 'notatpt))) + +(cl-defmethod forge-get-repository ((demand symbol) &optional remote notatpt) + "Return the current forge repository. + +First check if `forge-buffer-repository', or if that is nil, then +the repository for `forge-buffer-topic', satisfies DEMAND. If so, +then return that repository. + +Otherwise return the repository for `default-directory', if that +exists and satisfies DEMAND. If that fails too, then return nil +or signal an error, depending on DEMAND." + (or (and-let* ((repo (and (not notatpt) + (forge-repository-at-point)))) + (forge-get-repository repo 'noerror demand)) + (and-let* ((repo (or (forge-buffer-repository) + (and forge-buffer-topic + (forge-get-repository forge-buffer-topic))))) + (forge-get-repository repo 'noerror demand)) + (magit--with-refresh-cache + (list default-directory 'forge-get-repository demand) + (if (not (magit-gitdir)) + (when (memq demand forge--signal-no-entry) + (error + "Cannot determine Forge repository outside of Git repository")) + (unless remote + (setq remote (forge--get-remote 'warn))) + (if-let ((url (and remote + (magit-git-string "remote" "get-url" remote)))) + (and-let* ((repo (forge-get-repository url remote demand))) + (progn ; work around debbugs#31840 + (oset repo worktree (magit-toplevel)) + repo)) + (when (memq demand forge--signal-no-entry) + (error + "Cannot determine forge repository. %s\nSee %s." + (cond (remote (format "No url configured for %S." remote)) + ((and-let* ((config (magit-get "forge.remote"))) + (format "Value of `forge.remote' is %S but %s" + config "that remote does not exist."))) + ((magit-list-remotes) "Cannot decide on remote to use.") + (t "No remote configured.")) + "https://magit.vc/manual/forge/How-Forge-Detection-Works.html" + ))))))) + +(cl-defmethod forge-get-repository ((url string) &optional remote demand) + "Return the repository at URL." + (if-let ((parts (forge--split-forge-url url))) + (forge-get-repository parts remote (or demand :known?)) + (when (memq demand forge--signal-no-entry) + (error "Cannot determine forge repository. %s isn't a forge URL. %s" + url "You might have to customize `forge-alist'.")))) + +(cl-defmethod forge-get-repository (((host owner name) list) + &optional remote demand) + "((HOST OWNER NAME) &optional REMOTE DEMAND) + +Return the repository identified by HOST, OWNER and NAME. +See `forge-alist' for valid Git hosts." + (setq host (substring-no-properties host)) + (setq owner (substring-no-properties owner)) + (setq name (substring-no-properties name)) + (unless (memq demand '( :tracked :tracked? + :known? :insert! :valid? + :stub :stub?)) + (if-let ((new (pcase demand + ('t :tracked) + ('full :tracked?) + ('nil :known?) + ('create :insert!) + ('stub :stub) + ('maybe :stub?)))) + (progn + (message "Obsolete value for `%s's DEMAND: `%s'; use `%s' instead" + 'forge-get-repository demand new) + (setq demand new)) + (error "Unknown value for `%s's DEMAND: `%s'" + 'forge-get-repository demand))) + (if-let ((spec (forge--get-forge-host host t))) + (pcase-let ((`(,githost ,apihost ,webhost ,class) spec)) + ;; The `webhost' is used to identify the corresponding forge. + ;; For that reason it is stored in the `forge' slot. The id + ;; stored in the `id' slot also derives from that value. + (let* ((row (car (forge-sql [:select * :from repository + :where (and (= forge $s1) + (= owner $s2) + (= name $s3))] + webhost owner name))) + (obj (and row (closql--remake-instance class (forge-db) row)))) + ;; Synchronize the object with the entry from `forge-alist'. + ;; This only has an effect if the entry was modified, which + ;; should rarely, if ever, happen. Avoid confusion, by not + ;; mentioning this detail in any docstring. + (when obj + (oset obj apihost apihost) + (oset obj githost githost) + (oset obj remote remote)) + (pcase (list demand (and obj (eq (oref obj condition) :tracked))) + (`(:tracked? nil) (setq obj nil)) + (`(:tracked nil) + (error "Cannot use `%s' in %S yet.\n%s" + this-command (magit-toplevel) + "Use `M-x forge-add-repository' before trying again."))) + (when (and (memq demand '(:insert! :valid? :stub :stub?)) + (not obj)) + (pcase-let ((`(,id . ,forge-id) + (forge--repository-ids + class webhost owner name + (memq demand '(:stub :stub?)) + (eq demand :valid?)))) + (if (not id) + ;; `:valid?' was used and it turned out it is not. + (setq obj nil) + ;; The repo might have been renamed on the forge. #188 + (unless (setq obj (forge-get-repository :id id)) + (setq obj (funcall class + :id id + :forge-id forge-id + :forge webhost + :owner owner + :name name + :apihost apihost + :githost githost + :remote remote)) + (when (eq demand :insert!) + (closql-insert (forge-db) obj) + (oset obj condition :known)))))) + obj)) + (when (memq demand forge--signal-no-entry) + (error "Cannot determine forge repository. No entry for %S in %s" + host 'forge-alist)))) + +(cl-defmethod forge-get-repository ((repo forge-repository) + &optional noerror demand) + (setq noerror (and noerror t)) + (with-slots (condition slug) repo + (cl-symbol-macrolet + ((err (error "Requested %s for %s, but is %s" demand slug condition)) + (key (list (oref repo forge) + (oref repo owner) + (oref repo name))) + (ins (forge-get-repository key nil :insert!)) + (set (forge-get-repository key nil :valid?))) + (pcase-exhaustive (list demand condition noerror) + (`(nil ,_ ,_) repo) + (`(:tracked? :tracked ,_) repo) + (`(:tracked? ,_ ,_) nil) + (`(:tracked :tracked ,_) repo) + (`(:tracked ,_ t) nil) + (`(:tracked ,_ nil) err) + (`(:known? ,(or :tracked :known) ,_) repo) + (`(:known? ,_ ,_) nil) + (`(:insert! ,(or :tracked :known) ,_) repo) + (`(:insert! ,_ ,_) ins) + (`(:valid? ,(or :tracked :known) ,_) repo) + (`(:valid? ,_ ,_) set) + (`(:stub? ,_ ,_) repo) + (`(:stub ,_ ,_) repo))))) + +(cl-defmethod forge-get-repository ((_ null) &optional noerror demand) + (if (and (memq demand '(:insert! :tracked :stub)) + (not noerror)) + (error "(Maybe repository) is nil; `%s' not satisfied" demand) + nil)) + +(defun forge--get-repository:tracked? () + (forge-get-repository :tracked?)) + +(defun forge-repository-at-point (&optional demand) + "Return the repository at point. +If there is no such repository and DEMAND is non-nil, then signal +an error." + (or (magit-section-value-if 'forge-repo) + (and-let* ((topic (forge-topic-at-point))) + (forge-get-repository topic)) + (and (derived-mode-p 'forge-repository-list-mode) + (and-let* ((id (tabulated-list-get-id))) + (forge-get-repository :id id))) + (and demand (user-error "No repository at point")))) + +(defun forge--repo-for-thingatpt () + (or (magit-section-value-if 'forge-repo) + (and-let* ((topic (magit-section-value-if '(issue pullreq)))) + (forge-get-repository topic)) + (and (not forge-buffer-unassociated-p) + (or (forge-buffer-repository) + (forge-get-repository :known? nil 'notatpt))))) + +(defun forge-buffer-repository () + (and-let* ((id forge-buffer-repository)) + (forge-get-repository :id id))) + +(defun forge-set-buffer-repository () + "Initialize the value of variable `forge-buffer-repository'." + (unless forge-buffer-repository + (and-let* ((repo (forge-get-repository :known?))) + (setq forge-buffer-repository (oref repo id))))) + +(add-hook 'magit-mode-hook #'forge-set-buffer-repository) + +(defun forge-get-worktree (repo) + "Validate, remember and return a worktree for REPO. +If `default-directory' is within one of REPO's worktrees, record that +location in its `worktree' slot and return it. Otherwise, if a worktree +has been recorded before, validate that. If it still is a worktree of +REPO, return it, else set the slot to nil and return nil." + (if-let (((forge-repository-equal + repo (forge-get-repository :dir default-directory))) + (current-tree (magit-toplevel))) + (oset repo worktree current-tree) + (and-let* ((saved-tree (oref repo worktree))) + (and (file-accessible-directory-p saved-tree) + (if (forge-repository-equal + repo (forge-get-repository :dir saved-tree)) + saved-tree + (oset repo worktree nil)))))) + +;;;; List + +(defun forge--ls-repos () + (mapcar (let ((db (forge-db))) + (lambda (row) + (closql--remake-instance 'forge-repository db row))) + (forge-sql [:select * :from repository + :order-by [(asc owner) (asc name)]]))) + +(defun forge--ls-owned-repos () + (mapcar (let ((db (forge-db))) + (lambda (row) + (closql--remake-instance 'forge-repository db row))) + (forge-sql [:select * :from repository + :where (and (in owner $v1) + (not (in name $v2))) + :order-by [(asc owner) (asc name)]] + (vconcat (mapcar #'car forge-owned-accounts)) + (vconcat forge-owned-ignored)))) + +;;; Identity + +(defun forge-repository-equal (repo1 repo2) + "Return t if REPO1 and REPO2 are the same repository. +REPO1 and/or REPO2 may also be nil, in which case return nil." + (and repo1 repo2 + (or (equal (oref repo1 id) (oref repo2 id)) + (and (equal (oref repo1 githost) (oref repo2 githost)) + (equal (oref repo1 owner) (oref repo2 owner)) + (equal (oref repo1 name) (oref repo2 name)))))) + +(cl-defmethod forge--repository-ids ((class (subclass forge-repository)) + host owner name &optional stub noerror) + "Return (OUR-ID . THEIR-ID) of the specified repository. +If optional STUB is non-nil, then the IDs are not guaranteed to +be unique. Otherwise this method has to make an API request to +retrieve THEIR-ID, the repository's ID on the forge. In that +case OUR-ID derives from THEIR-ID and is unique across all +forges and hosts." + (pcase-let* ((`(,_githost ,apihost ,id ,_class) + (forge--get-forge-host host t)) + (path (format "%s/%s" owner name)) + (their-id (and (not stub) + (ghub-repository-id + owner name + :host apihost + :auth 'forge + :forge (forge--ghub-type-symbol class) + :noerror noerror)))) + (and (or stub their-id (not noerror)) + (cons (base64-encode-string + (format "%s:%s" id + (cond (stub path) + ((eq class 'forge-github-repository) + ;; This is base64 encoded, according to + ;; https://docs.github.com/en/graphql/ + ;; reference/scalars#id. Unfortunately + ;; that is not always true. E.g., + ;; https://github.com/dit7ya/roamex. + (condition-case nil + (base64-decode-string their-id) + (error their-id))) + (t their-id))) + t) + (or their-id path))))) + +(cl-defmethod forge--repository-ids ((_class (subclass forge-noapi-repository)) + host owner name &optional _stub _noerror) + (let ((their-id (if owner (concat owner "/" name) name))) + (cons (base64-encode-string + (format "%s:%s" + (nth 3 (forge--get-forge-host host t)) + their-id) + t) + their-id))) + +;;; Read + +(defun forge-read-repository (prompt) + (let ((choice (magit-completing-read + prompt + (mapcar (pcase-lambda (`(,host ,owner ,name)) + (format "%s/%s @%s" owner name host)) + (forge-sql [:select [githost owner name] + :from repository])) + nil t nil nil + (and-let* ((default (forge-get-repository :stub?))) + (format "%s/%s @%s" + (oref default owner) + (oref default name) + (oref default githost)))))) + (save-match-data + (if (string-match "\\`\\(.+\\)/\\([^/]+\\) @\\(.+\\)\\'" choice) + (forge-get-repository (list (match-string 3 choice) + (match-string 1 choice) + (match-string 2 choice))) + (error "BUG"))))) + +(defun forge-read-host (prompt &optional class) + (magit-completing-read + prompt + (if class + (seq-keep (pcase-lambda (`(,githost ,_apihost ,_webhost ,c)) + (and (child-of-class-p c class) githost)) + forge-alist) + (mapcar #'car forge-alist)) + nil t)) + +;;; Miscellaneous + +(defun forge--as-githost (host) + (or (car (car (cl-member host forge-alist :test #'equal :key #'car))) + (car (car (cl-member host forge-alist :test #'equal :key #'cadr))) + (car (car (cl-member host forge-alist :test #'equal :key #'caddr))) + (user-error "Cannot determine githost for %S" host))) + +(defun forge--as-apihost (host) + (or (cadr (car (cl-member host forge-alist :test #'equal :key #'cadr))) + (cadr (car (cl-member host forge-alist :test #'equal :key #'car))) + (cadr (car (cl-member host forge-alist :test #'equal :key #'caddr))) + (user-error "Cannot determine apihost for %S" host))) + +(cl-defmethod forge--format ((repo forge-repository) format-or-slot &optional spec) + (pcase-let* (((eieio (forge webhost) owner name) repo) + (path (if owner (concat owner "/" name) name))) + (format-spec + (let ((format (if (symbolp format-or-slot) + (eieio-oref repo format-or-slot) + format-or-slot))) + (if (member webhost ghub-insecure-hosts) + (replace-regexp-in-string "\\`https://" "http://" format t t) + format)) + `(,@spec + (?h . ,webhost) + (?o . ,owner) + (?n . ,name) + (?p . ,path) + (?P . ,(string-replace "/" "%2F" path)))))) + +(defun forge--set-field-callback (topic) + (lambda (&rest _) + (forge--pull-topic + (forge-get-repository topic) + topic + :callback (lambda () + (forge-refresh-buffer) + (when (transient-active-prefix + '(forge-topic-menu + forge-topics-menu + forge-notifications-menu)) + (transient--refresh-transient)))))) + +(defvar forge--mode-line-buffer nil) + +(defun forge--msg (repo echo done format &rest args) + (let ((msg (apply #'format format args))) + (when repo + (setq msg (string-replace + "REPO" + (concat (oref repo owner) "/" (oref repo name)) + msg))) + (when (and echo msg) + (message "%s%s" msg (if done "...done" "..."))) + (when (buffer-live-p forge--mode-line-buffer) + (with-current-buffer forge--mode-line-buffer + (setq mode-line-process + (if done + nil + (concat " " (propertize msg 'font-lock-face + 'magit-mode-line-process))))) + (force-mode-line-update t)))) + +(cl-defmethod ghub--host ((repo forge-repository)) + (cl-call-next-method (forge--ghub-type-symbol (eieio-object-class repo)))) + +(cl-defmethod ghub--username ((repo forge-repository)) + (let ((default-directory default-directory)) + (unless (forge-repository-equal (forge-get-repository :stub?) repo) + (when-let ((worktree (forge-get-worktree repo))) + (setq default-directory worktree))) + (cl-call-next-method (oref repo apihost) + (forge--ghub-type-symbol (eieio-object-class repo))))) + +(defun forge--ghub-type-symbol (class) + (pcase-exhaustive class + ;; This package does not define a `forge-gitlab-http-repository' + ;; class, but we used to suggest at #9 that users define such a class + ;; if they must connect to a Gitlab instance that uses http instead + ;; of https. Doing that isn't necessary anymore, but we have to keep + ;; supporting it here. It is now sufficient to add an entry to + ;; `ghub-insecure-hosts'. + ((or 'forge-gitlab-repository 'forge-gitlab-http-repository) 'gitlab) + ('forge-github-repository 'github) + ('forge-gitea-repository 'gitea) + ('forge-gogs-repository 'gogs) + ('forge-bitbucket-repository 'bitbucket))) + +;;; _ +(provide 'forge-repo) +;;; forge-repo.el ends here diff --git a/elpa/forge-20241218.2036/forge-repos.el b/elpa/forge-20241218.2036/forge-repos.el new file mode 100644 index 00000000..90dd572f --- /dev/null +++ b/elpa/forge-20241218.2036/forge-repos.el @@ -0,0 +1,191 @@ +;;; 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 (make-composed-keymap forge-common-map tabulated-list-mode-map) + "n" #'forge-dispatch + "RET" #'forge-visit-this-repository + "" #'forge-visit-this-repository + "o" #'forge-browse-this-repository + " " #'forge-repositories-menu) + +(defvar-local forge--buffer-list-filter nil) + +(defvar forge-repository-list-buffer-name "*forge-repositories*" + "Buffer name to use for displaying lists of repositories.") + +(defvar forge-repository-list-mode-name + '((:eval (capitalize + (concat (if forge--buffer-list-filter + (format "%s " forge--buffer-list-filter) + "") + "repositories")))) + "Information shown in the mode-line for `forge-repository-list-mode'. +Must be set before `forge-list' is loaded.") + +(define-derived-mode forge-repository-list-mode tabulated-list-mode + forge-repository-list-mode-name + "Major mode for browsing a list of repositories." + :interactive nil + (setq-local x-stretch-cursor nil) + (setq tabulated-list-padding 0) + (setq tabulated-list-sort-key (cons "Owner" nil))) + +(defun forge-repository-list-setup (filter fn) + (let ((buffer (get-buffer-create forge-repository-list-buffer-name))) + (with-current-buffer buffer + (setq default-directory "/") + (setq forge--tabulated-list-columns forge-repository-list-columns) + (setq forge--tabulated-list-query fn) + (cl-letf (((symbol-function #'tabulated-list-revert) #'ignore)) ; see #229 + (forge-repository-list-mode)) + (setq forge--buffer-list-filter filter) + (forge--tablist-refresh) + (add-hook 'tabulated-list-revert-hook #'forge--tablist-refresh nil t) + (tabulated-list-print) + (when hl-line-mode + (hl-line-highlight))) + (switch-to-buffer buffer))) + +(defun forge-format-repo-condition (repo) + "Return a character representing the value of REPO's `condition' slot." + (pcase-exhaustive (oref repo condition) + (:tracked "*") + (:known " ") + (:stub (propertize "s" 'face 'warning)))) + +(defun forge-format-repo-selective (repo) + "Return a character representing the value of REPO's `selective-p' slot." + (pcase-exhaustive (oref repo selective-p) + ('t "*") + ('nil " "))) + +;;; Commands +;;;; Menu + +;;;###autoload(autoload 'forge-repositories-menu "forge-repos" nil t) +(transient-define-prefix forge-repositories-menu () + "Control list of repositories displayed in the current buffer." + :transient-suffix t + :transient-non-suffix #'transient--do-call + :transient-switch-frame nil + :refresh-suffixes t + :environment #'forge--menu-environment + :column-widths forge--topic-menus-column-widths + [:hide always ("q" forge-menu-quit-list)] + [forge--topic-menus-group + forge--lists-group + ["Filter" + ("o" "owned" forge-list-owned-repositories + :if-nil forge--buffer-list-filter) + ("o" "owned" forge-list-repositories + :face forge-suffix-active + :if-non-nil forge--buffer-list-filter + :inapt-if-mode nil)]] + (interactive) + (unless (derived-mode-p 'forge-repository-list-mode) + (if-let ((buffer (get-buffer forge-repository-list-buffer-name))) + (switch-to-buffer buffer) + (forge-list-repositories))) + (transient-setup 'forge-repositories-menu)) + +(transient-augment-suffix forge-repositories-menu + :transient #'transient--do-replace + :if-mode 'forge-repository-list-mode + :inapt-if (lambda () (eq (oref transient--prefix command) 'forge-repositories-menu)) + :inapt-face 'forge-suffix-active) + +;;;; List + +(defclass forge--repo-list-command (transient-suffix) + ((type :initarg :type :initform nil) + (filter :initarg :filter :initform nil) + (global :initarg :global :initform nil))) + +;;;###autoload(autoload 'forge-list-repositories "forge-repos" nil t) +(transient-define-suffix forge-list-repositories () + "List known repositories in a separate buffer. +Here \"known\" means that an entry exists in the local database." + :class 'forge--repo-list-command :type 'repo :global t + :inapt-if-mode 'forge-repository-list-mode + :inapt-face 'forge-suffix-active + (declare (interactive-only nil)) + (interactive) + (forge-repository-list-setup nil #'forge--ls-repos) + (transient-setup 'forge-repositories-menu)) + +;;;###autoload(autoload 'forge-list-owned-repositories "forge-repos" nil t) +(transient-define-suffix forge-list-owned-repositories () + "List your own known repositories in a separate buffer. +Here \"known\" means that an entry exists in the local database +and options `forge-owned-accounts' and `forge-owned-ignored' +controls which repositories are considered to be owned by you. +Only Github is supported for now." + :class 'forge--repo-list-command :type 'repo :filter 'owned :global t + (interactive) + (forge-repository-list-setup 'owned #'forge--ls-owned-repos) + (transient-setup 'forge-repositories-menu)) + +;;; _ +(provide 'forge-repos) +;;; forge-repos.el ends here diff --git a/elpa/forge-20241218.2036/forge-revnote.el b/elpa/forge-20241218.2036/forge-revnote.el new file mode 100644 index 00000000..da550632 --- /dev/null +++ b/elpa/forge-20241218.2036/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-20241218.2036/forge-semi.el b/elpa/forge-20241218.2036/forge-semi.el new file mode 100644 index 00000000..a7f68068 --- /dev/null +++ b/elpa/forge-20241218.2036/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-20241218.2036/forge-tablist.el b/elpa/forge-20241218.2036/forge-tablist.el new file mode 100644 index 00000000..7252c624 --- /dev/null +++ b/elpa/forge-20241218.2036/forge-tablist.el @@ -0,0 +1,81 @@ +;;; 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) + +(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-20241218.2036/forge-topic.el b/elpa/forge-20241218.2036/forge-topic.el new file mode 100644 index 00000000..dd66c0c7 --- /dev/null +++ b/elpa/forge-20241218.2036/forge-topic.el @@ -0,0 +1,1753 @@ +;;; 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 'eieio-custom) +(require 'markdown-mode) +(require 'parse-time) +(require 'yaml) + +(require 'forge) +(require 'forge-post) + +(defvar bug-reference-auto-setup-functions) + +;;; Options + +(defcustom forge-limit-topic-choices t + "Whether to initially limit completion candidates to active topics." + :package-version '(forge . "0.4.0") + :group 'forge + :type 'boolean) + +(defcustom forge-post-heading-format "%a %C\n" + "Format for post headings in topic view. + +The following %-sequences are supported: + +`%a' The forge nickname of the author. +`%c' The absolute creation date. +`%C' The relative creation date." + :package-version '(forge . "0.1.0") + :group 'forge + :type 'string) + +(defcustom forge-post-fill-region t + "Whether to call `fill-region' before displaying forge posts." + :package-version '(forge . "0.1.0") + :group 'forge + :type 'boolean) + +(defcustom forge-topic-repository-slug-width 28 + "Width of repository slugs (i.e., \"OWNER/NAME\")." + :package-version '(forge . "0.4.0") + :group 'forge + :type 'natnum) + +(defcustom forge-bug-reference-hooks + '(find-file-hook + forge-post-mode-hook + git-commit-setup-hook + magit-mode-hook) + "Hooks to which `forge-bug-reference-setup' is added. +This variable has to be customized before `forge' is loaded." + :package-version '(forge . "0.2.0") + :group 'forge + :options '(find-file-hook + forge-post-mode-hook + git-commit-setup-hook + magit-mode-hook) + :type '(list :convert-widget custom-hook-convert-widget)) + +(defvar forge-format-avatar-function nil + "Function used to insert avatars in certain locations. +This is experimental and intended for users who wish to +implement such a function themselves. See #447.") + +;;; Faces +;;;; Common + +(defface forge-dimmed '((t :foreground "#93a1a1")) + "Parent face or faces used for text that shouldn't stand out. + +This face is not directly, instead several faces inherit from it +either directly or via an intermediate face. This face should +only specify the `:foreground' attribute, which is why this face +does not inherit from `magit-dimmed'." + :group 'forge-faces) + +(defface forge-topic-header-line + '((t :inherit magit-header-line :foreground reset)) + "Face for the `header-line' in `forge-topic-mode' buffers." + :group 'forge-faces) + +;;;; Topic and Notification Slugs + +(defface forge-topic-slug-open + '((t :inherit forge-dimmed)) + "Face uses for slugs of open topics." + :group 'forge-faces) + +(defface forge-topic-slug-completed + '((t :inherit forge-dimmed)) + "Face used for slugs of completed topics." + :group 'forge-faces) + +(defface forge-topic-slug-unplanned + '((t :inherit forge-dimmed :strike-through t)) + "Face used for slugs of unplanned topics. +E.g., for issues closes as \"unplanned\" and pull-requests that +were closed without being merged." + :group 'forge-faces) + +(defface forge-topic-slug-saved + '((t :foreground "orange")) + "Face used for slugs of topics with saved notifications." + :group 'forge-faces) + +(defface forge-topic-slug-unread + '((t :weight bold)) + "Face used for slugs of topics with unread notifications." + :group 'forge-faces) + +;;;; Topic and Notification Summaries +;;;;; Notifications + +(defface forge-topic-unread + '((t :weight bold + :box (:line-width (-1 . -1) :style nil))) + "Face used for summaries of entities with unread notifications. +This face is always used together with, and takes preference over, +a `forge-{issue,pullreq}-STATE' face and should not specify any +attribute that is specified by any of those faces. Likewise those +faces should not set `:weight' or `:slant'." + :group 'forge-faces) + +(defface forge-topic-pending + '((t :weight bold)) + "Face used for summaries of entities with open notifications. +This face is always used together with, and takes preference over, +a `forge-{issue,pullreq}-STATE' face and should not specify any +attribute that is specified by any of those faces. Likewise those +faces should not set `:weight' or `:slant'." + :group 'forge-faces) + +(defface forge-topic-done + '((t)) + "Face used for summaries of entities with no unread or open notification. +This face is always used together with, and takes preference over, +a `forge-{issue,pullreq}-STATE' face and should not specify any +attribute that is specified by any of those faces. Likewise those +faces should not set `:weight' or `:slant'." + :group 'forge-faces) + +;;;;; Issues + +(defface forge-issue-open + '((t)) + "Face used for summaries of open issues." + :group 'forge-faces) + +(defface forge-issue-completed + '((t :inherit forge-dimmed)) + "Face used for summaries of issues closed as completed." + :group 'forge-faces) + +(defface forge-issue-unplanned + '((t :inherit forge-dimmed :strike-through t)) + "Face used for summaries of issues closed as unplanned." + :group 'forge-faces) + +;;;;; Pull-Requests + +(defface forge-pullreq-open + '((t :foreground "LimeGreen")) + "Face used for summaries of open pull-requests." + :group 'forge-faces) + +(defface forge-pullreq-merged + '((t :foreground "MediumPurple")) + "Face used for summaries of merged pull-requests." + :group 'forge-faces) + +(defface forge-pullreq-rejected + '((t :foreground "MediumPurple" :strike-through t)) + "Face used for summaries of closed pull-requests, that weren't merged." + :group 'forge-faces) + +(defface forge-pullreq-draft + '((t :slant italic)) + "Face used for summaries of draft pull-requests. +A face attribute should be used that is not already used by any +`forge-topic-STATUS' or `forge-{issue,pullreq}-STATE' face." + :group 'forge-faces) + +;;;; Labels + +(defface forge-topic-label + '((t :inherit secondary-selection + :box (:line-width (-1 . -1) :style released-button))) + "Face used for topic labels, marks and milestones." + :group 'forge-faces) + +;;;; Post Details + +(defface forge-post-author + '((t :inherit bold)) + "Face used for post author in topic view." + :group 'forge-faces) + +(defface forge-post-date + '((t :inherit italic)) + "Face used for post date in topic view." + :group 'forge-faces) + +;;; Class + +(defclass forge-topic (forge-post) () :abstract t) + +(cl-defmethod forge--object-id ((class (subclass forge-topic)) repo number) + "Return the id for a CLASS object in REPO identified by id NUMBER." + (base64-encode-string + (encode-coding-string + (format "%s:%s%s" + (base64-decode-string (oref repo id)) + (substring (symbol-name class) + (length (oref-default class closql-class-prefix))) + number) + 'utf-8) + t)) + +(cl-defmethod forge--object-id ((prefix string) number-or-id) + (base64-encode-string + (encode-coding-string + (format "%s:%s" + (base64-decode-string prefix) + (if (numberp number-or-id) + number-or-id + ;; Currently every ID is base64 encoded. Unfortunately + ;; we cannot use the IDs of Gitlab labels (see comment + ;; in the respective `forge--update-labels' method), + ;; and have to use their names, which are not encoded. + (or (ignore-errors (base64-decode-string number-or-id)) + number-or-id))) + 'utf-8) + t)) + +(cl-defmethod forge-topic-mark-read ((topic forge-topic)) + (when (eq (oref topic status) 'unread) + (oset topic status 'pending))) + +(cl-defmethod forge--set-topic-marks ((_repo forge-repository) topic marks) + (oset topic marks + (mapcar #'car (forge-sql [:select id :from mark :where (in name $v1)] + (vconcat marks)))) + (forge-refresh-buffer)) + +;;; Query +;;;; Get + +(cl-defmethod forge-get-parent ((topic forge-topic)) + (forge-get-repository topic)) + +(cl-defmethod forge-get-repository ((topic forge-topic)) + (closql-get (forge-db) + (oref topic repository) + 'forge-repository)) + +(cl-defmethod forge-get-topic ((topic forge-topic)) + topic) + +(cl-defmethod forge-get-topic ((repo forge-repository) number-or-id) + (if (numberp number-or-id) + (if (< number-or-id 0) + (forge-get-pullreq repo (abs number-or-id)) + (or (forge-get-issue repo number-or-id) + (forge-get-pullreq repo number-or-id))) + (or (forge-get-issue number-or-id) + (forge-get-pullreq number-or-id)))) + +(cl-defmethod forge-get-topic ((number integer)) + (if (< number 0) + (forge-get-pullreq (abs number)) + (or (forge-get-issue number) + (forge-get-pullreq number)))) + +(cl-defmethod forge-get-topic ((id string)) + (or (forge-get-issue id) + (forge-get-pullreq id))) + +;;;; Current + +(defun forge-current-topic (&optional demand) + "Return the topic at point or being visited. +If there is no such topic and DEMAND is non-nil, then signal +an error." + (or (forge-topic-at-point) + forge-buffer-topic + (and demand (user-error "No current topic")))) + +(defun forge-topic-at-point (&optional demand) + "Return the topic at point. +If there is no such topic and DEMAND is non-nil, then signal +an error." + (or (thing-at-point 'forge-topic) + (magit-section-value-if '(issue pullreq)) + (forge-get-pullreq :branch) + (and demand (user-error "No topic at point")))) + +(put 'forge-topic 'thing-at-point #'forge-thingatpt--topic) +(defun forge-thingatpt--topic () + (and-let* ((repo (forge--repo-for-thingatpt))) + (and (thing-at-point-looking-at + (if (forge-gitlab-repository--eieio-childp repo) + "\\(?2:[#!]\\)\\(?1:[0-9]+\\)\\_>" + "#\\([0-9]+\\)\\_>")) + (funcall (if (equal (match-string 2) "!") + #'forge-get-pullreq + #'forge-get-topic) + repo (string-to-number (match-string-no-properties 1)))))) + +(defun forge-region-topics () + (magit-region-values '(issue pullreq))) + +;;;; List + +(defvar-local forge--buffer-topics-spec nil) +(put 'forge--buffer-topics-spec 'permanent-local t) + +(defun forge--init-buffer-topics-spec () + (unless forge--buffer-topics-spec + (setq forge--buffer-topics-spec + (clone forge-status-buffer-default-topic-filters)))) +(add-hook 'magit-status-mode-hook #'forge--init-buffer-topics-spec) + +(defun forge--clone-buffer-topics-spec () + (forge--init-buffer-topics-spec) + (clone forge--buffer-topics-spec)) + +(defclass forge--topics-spec () + ((type :documentation "\ +Limit list based on topic type." + :initarg :type + :initform 'topic + :type (member topic issue pullreq nil) + :custom (choice + (const topic) + (const issue) + (const pullreq) + (const :tag "disable topic sections (nil)" nil))) + (active :documentation "\ +Limit list to active topics. + +A topic is \"active\" if its state (public condition) is open and/or +its status (private condition) is unread or pending. + +When this is t, then the value of the `state' and `status' slots are +ignored." + :initarg :active + :initform t + :type boolean + :custom boolean) + (state :documentation "\ +Limit list based on topic (public) state. + +State is the \"public condition\". I.e., is the topic still open?" + :initarg :state + :initform 'open + :type (satisfies (lambda (val) + (member val '(open + (completed merged) + (unplanned rejected) + nil)))) + :custom (choice + (const open) + (const (completed merged)) + (const (unplanned rejected)) + (const :tag "all (nil)" nil))) + (status :documentation "\ +Limit list based on topic (private) status. + +Status is the \"private condition\". I.e., have you decided yet +that *you* are done with the topic, and have others made changes, +which *you* have not seen yet? + +`inbox' means \"`unread' or `pending'\"." + :initarg :status + :initform nil + :type (member inbox unread pending done nil) + :custom (choice + (const inbox) + (const unread) + (const pending) + (const done) + (const :tag "all (nil)" nil))) + (updated :documentation "\ +Date when topic was last updated." + :initarg :updated + :initform nil + :type (or string null)) + (milestone :documentation "\ +Limit list to topics assigned to given milestone." + :initarg :milestone + :initform nil + :type (or string null) + :custom string) + (labels :documentation "\ +Limit list to topics with at least one of the given labels." + :initarg :labels + :initform nil + :type (list-of string) + :custom (repeat string)) + (marks :documentation "\ +Limit list to topics with at least one of the given marks. +Marks are like labels, but they are private and local to the +current Forge database." + :initarg :marks + :initform nil + :type (list-of string) + :custom (repeat string)) + (saved :documentation "Limit list to saved topics." + :initarg :saved + :initform nil + :type boolean + :custom boolean) + (author :documentation "\ +Limit list to topics created by given user." + :initarg :author + :initform nil + :label "Author (username)" + :type (or string null) + :custom string) + (assignee :documentation "\ +Limit list to topics assigned to given user." + :initarg :assignee + :initform nil + :label "Assignee (username)" + :type (or string null) + :custom string) + (reviewer :documentation "\ +Limit list to topics for which a review by the given user was requested." + :initarg :reviewer + :initform nil + :label "Reviewer (username)" + :type (or string null) + :custom string) + (global :documentation "Whether to list topics for all repositories." + :initarg :global + :initform nil + :type boolean) + (order :documentation "Order in which topics are listed." + :initarg :order + :initform 'newest + :type (member newest oldest recently-updated anciently-updated) + :custom (choice (const newest) + (const oldest) + (const recently-updated) + (const anciently-updated))) + (limit :documentation "Number of topics to list at most." + :initarg :limit + :initform 200 + :type integer + :custom natnum) + (grouped :documentation "Whether to group topics by repository." + :initarg :grouped + :initform nil + :type boolean + :custom boolean))) + +(cl-defun forge--list-topics + (&optional (spec forge--buffer-topics-spec) + (repo (forge-get-repository :tracked?)) + (type (oref spec type))) + (when (oref spec reviewer) + (setq type 'pullreq)) + (if (eq type 'topic) + (pcase-let ((`(,pred ,slot) (pcase (oref spec order) + ('newest '(> number)) + ('oldest '(< number)) + ('recently-updated '(> updated)) + ('anciently-updated '(< updated))))) + (cl-sort (nconc (forge--list-topics-1 spec repo 'issue) + (forge--list-topics-1 spec repo 'pullreq)) + pred :key (lambda (obj) (eieio-oref obj slot)))) + (forge--list-topics-1 spec repo type))) + +(defun forge--list-topics-1 (spec repo type) + (mapcar (apply-partially #'closql--remake-instance + (if (eq type 'issue) 'forge-issue 'forge-pullreq) + (forge-db)) + (forge-sql (forge--list-topics-2 spec repo type)))) + +(defun forge--list-topics-2 (spec repo type) + (pcase-let (((eieio active state status milestone labels marks + saved author assignee reviewer global order limit) + spec)) + (cond (active + (setq state 'open) + (setq status '(unread pending))) + ((eq status 'inbox) + (setq status '(unread pending)))) + `[:select :distinct topic:* + :from [(as ,type topic)] + ,@(cond + (milestone + `[:join milestone :on (= milestone:title ,milestone)])) + ,@(cond + ((not labels) nil) + ((eq type 'issue) + [:join issue-label :on (= issue-label:issue topic:id) + :join label :on (= label:id issue-label:id)]) + ([:join pullreq-label :on (= pullreq-label:pullreq topic:id) + :join label :on (= label:id pullreq-label:id)])) + ,@(cond + ((not marks) nil) + ((eq type 'issue) + [:join issue-mark :on (= issue-mark:issue topic:id) + :join mark :on (= mark:id issue-mark:id)]) + ([:join pullreq-mark :on (= pullreq-mark:pullreq topic:id) + :join mark :on (= mark:id pullreq-mark:id)])) + ,@(cond + ((not assignee) nil) + ((eq type 'issue) + [:join issue-assignee :on (= issue-assignee:issue topic:id) + :join assignee :on (= assignee:id issue-assignee:id)]) + ([:join pullreq-assignee :on (= pullreq-assignee:pullreq topic:id) + :join assignee :on (= assignee:id pullreq-assignee:id)])) + ,@(cond + (reviewer + [:join (as pullreq-review-request r) :on (= r:pullreq topic:id) + :join assignee :on (= assignee:id r:id)])) + :where + (and + ,@(and (not global) repo `((= topic:repository ,(oref repo id)))) + ,@(cond + ((and active state status) + `((or (in topic:state ,(vconcat (ensure-list state))) + (in topic:status ,(vconcat (ensure-list status)))))) + (`(,@(and state `((in topic:state ,(vconcat (ensure-list state))))) + ,@(and status `((in topic:status ,(vconcat (ensure-list status)))))))) + ,@(and milestone '((= topic:milestone milestone:id))) + ,@(and labels `((or ,@(mapcar (lambda (l) `(= label:name ,l)) labels)))) + ,@(and marks `((or ,@(mapcar (lambda (m) `(= mark:name ,m)) marks)))) + ,@(and saved '((= topic:saved-p 't))) + ,@(and author `((= topic:author ,author))) + ,@(and assignee `((= assignee:login ,assignee))) + ,@(and reviewer `((= assignee:login ,reviewer)))) + :order-by [,(pcase order + ('newest '(desc topic:number)) + ('oldest '(asc topic:number)) + ('recently-updated '(desc topic:updated)) + ('anciently-updated '(asc topic:updated)))] + ,@(and limit `(:limit ,limit))])) + +;;; Read + +(defun forge-read-topic (prompt) + "Read an active topic with completion using PROMPT. + +Open, unread and pending topics are considered active. +Default to the current topic, even if it isn't active. + +\\While completion is in \ +progress, \\[forge-read-topic-lift-limit] lifts the limit, extending +the completion candidates to include all topics. + +If `forge-limit-topic-choices' is nil, then all candidates +can be selected from the start." + (forge--read-topic prompt + #'forge-current-topic + (forge--topics-spec :type 'topic :active t) + (forge--topics-spec :type 'topic :active nil :state nil))) + +(defun forge--read-topic (prompt current active all) + (let* ((current (funcall current)) + (repo (forge-get-repository (or current :tracked))) + (default (and current (forge--format-topic-line current))) + (alist (forge--topic-collection + (forge--list-topics (if forge-limit-topic-choices active all) + repo))) + (choices (mapcar #'car alist)) + (choices (cond ((and forge-limit-topic-choices + default + (not (member default choices))) + (push (cons default (oref current id)) alist) + (cons default choices)) + (choices))) + (choice + (if forge-limit-topic-choices + (minibuffer-with-setup-hook + (lambda () + (use-local-map (make-composed-keymap + forge-read-topic-minibuffer-map + (current-local-map)))) + (magit-completing-read + (substitute-command-keys + (format "%s \\<%s> (\\[%s] for all)" prompt + 'forge-read-topic-minibuffer-map + 'forge-read-topic-lift-limit)) + (completion-table-dynamic + (let (all-choices) + (lambda (_string) + (cond + (all-choices) + (forge-limit-topic-choices choices) + (t + (forge--replace-minibuffer-prompt (concat prompt ": ")) + (setq alist (forge--topic-collection + (forge--list-topics all repo))) + (setq all-choices (mapcar #'car alist))))))) + nil t nil nil default)) + (magit-completing-read prompt choices nil t nil nil default)))) + (cdr (assoc choice alist)))) + +(defun forge--topic-collection (topics) + (mapcar (lambda (topic) + (cons (forge--format-topic-line topic) + (oref topic id))) + topics)) + +(defvar-keymap forge-read-topic-minibuffer-map + "+" #'forge-read-topic-lift-limit) + +(defun forge-read-topic-lift-limit () + "No longer limit completion candidates to active topics." + (interactive) + (when (and (minibufferp) + forge-limit-topic-choices) + (setq-local forge-limit-topic-choices nil) + (when (and (bound-and-true-p vertico-mode) + (boundp 'vertico--input) + (fboundp 'vertico--exhibit)) + (setq vertico--input t) + (vertico--exhibit)))) + +(defun forge--replace-minibuffer-prompt (prompt) + (save-excursion + (goto-char (point-min)) + (let ((inhibit-read-only t) + (end (length prompt))) + ;; (insert-and-inherit prompt) would discard all faces already + ;; present in PROMPT, so instead we do it like `read_minibuf'. + (put-text-property 0 end 'front-sticky t prompt) + (put-text-property 0 end 'rear-nonsticky t prompt) + (put-text-property 0 end 'field t prompt) + (let ((props minibuffer-prompt-properties)) + (while props + (let ((key (pop props)) + (val (pop props))) + (if (eq key 'face) + (add-face-text-property 0 end val t prompt) + (put-text-property 0 end key val prompt))))) + (insert prompt) + (delete-region (point) (minibuffer-prompt-end))))) + +(defun forge-topic-completion-at-point () + (let ((bol (line-beginning-position)) + repo) + (and (looking-back "[!#][0-9]*" bol) + (or (not bug-reference-prog-mode) + (nth 8 (syntax-ppss))) ; inside comment or string + (setq repo (forge-get-repository :tracked)) + (looking-back (if (forge--childp repo 'forge-gitlab-repository) + "\\(?3:[!#]\\)\\(?2:[0-9]*\\)" + "#\\(?2:[0-9]*\\)") + bol) + (list (match-beginning 2) + (match-end 0) + (mapcar (lambda (row) + (propertize (number-to-string (car row)) + :title (format " %s" (cadr row)))) + (if (forge--childp repo 'forge-gitlab-repository) + (forge-sql [:select [number title] + :from $i1 + :where (= repository $s2) + :order-by [(desc updated)]] + (if (equal (match-string 3) "#") + 'issue + 'pullreq) + (oref repo id)) + (forge-sql [:select [number title updated] + :from pullreq + :where (= repository $s1) + :union + :select [number title updated] + :from issue + :where (= repository $s1) + :order-by [(desc updated)]] + (oref repo id)))) + :annotation-function (lambda (c) (get-text-property 0 :title c)))))) + +(defun forge-read-topic-title (topic) + (read-string "Title: " (oref topic title))) + +(defun forge-read-topic-milestone (&optional topic) + (forge--completing-read + "Milestone" + (mapcar #'caddr (oref (forge-get-repository (or topic :tracked)) milestones)) + nil t + (and topic (forge--format-topic-milestone topic)))) + +(defun forge-read-topic-labels (&optional obj) + (let ((crm-separator ",")) + (magit-completing-read-multiple + "Labels: " + (forge--format-labels (and obj (forge-get-repository obj))) + nil t + (and (forge-topic-p obj) + (forge--format-labels obj crm-separator))))) + +(defun forge-read-topic-marks (&optional obj) + (let ((crm-separator ",")) + (magit-completing-read-multiple + "Marks: " (forge--format-marks) nil t + (and (forge-topic-p obj) + (forge--format-marks obj crm-separator))))) + +(defun forge-read-topic-assignees (&optional topic) + (let* ((repo (forge-get-repository (or topic :tracked))) + (value (and topic (oref topic assignees))) + (choices (mapcar #'cadr (oref repo assignees))) + (crm-separator ",")) + (magit-completing-read-multiple + "Assignees: " choices nil + (if (forge--childp repo 'forge-gitlab-repository) + t ; Selecting something else would fail later on. + 'confirm) + (mapconcat #'cadr value ",")))) + +(defun forge-read-topic-review-requests (&optional topic) + (let* ((repo (forge-get-repository (or topic :tracked))) + (value (and topic (oref topic review-requests))) + (choices (mapcar #'cadr (oref repo assignees))) + (crm-separator ",")) + (magit-completing-read-multiple + "Request review from: " choices nil + 'confirm + (mapconcat #'cadr value ",")))) + +(defun forge--completing-read ( prompt collection &optional + predicate require-match initial-input + hist def) + ;; NOTE Only required until `magit-completing-read' has been + ;; updated to allow empty input if require-match is t. + (let ((reply (funcall magit-completing-read-function + (concat prompt ": ") + (if (and def (not (member def collection))) + (cons def collection) + collection) + predicate + require-match initial-input hist def))) + (if (equal reply "") + (if (and require-match (not (eq require-match t))) + (user-error "Nothing selected") + nil) + reply))) + +;;; Format + +(cl-defmethod forge--format ((topic forge-topic) slot &optional spec) + (forge--format (forge-get-repository topic) slot + `(,@spec (?i . ,(oref topic number))))) + +(defun forge--format-topic-line (topic &optional width) + (concat + (and (or (and (derived-mode-p 'forge-notifications-mode) + (eq forge-notifications-display-style 'flat)) + (and (derived-mode-p 'forge-topics-mode) + (oref forge--buffer-topics-spec global) + (not (oref forge--buffer-topics-spec grouped)))) + (concat (truncate-string-to-width + (oref (forge-get-repository topic) slug) + forge-topic-repository-slug-width + nil ?\s t) + " ")) + ;; MAYBE bring this back once we support discussions. + ;; (cond (no-indicator nil) + ;; ((forge-issue-p topic) (magit--propertize-face "I " 'magit-dimmed)) + ;; ((forge-pullreq-p topic) (magit--propertize-face "P " 'magit-dimmed)) + ;; (t (magit--propertize-face "* " 'error))) + (string-pad (forge--format-topic-slug topic) (or width 5)) + " " + (forge--format-topic-title topic))) + +(defun forge--format-topic-slug (topic) + (with-slots (slug state status saved-p) topic + (magit--propertize-face + slug + `(,@(and saved-p '(forge-topic-slug-saved)) + ,@(and (eq status 'unread) '(forge-topic-slug-unread)) + ,(pcase state + ('open 'forge-topic-slug-open) + ((or 'completed 'merged) 'forge-topic-slug-completed) + ((or 'unplanned 'rejected) 'forge-topic-slug-unplanned)))))) + +(defun forge--format-topic-refs (topic) + (pcase-let + (((eieio cross-repo-p base-repo base-ref head-repo head-ref) topic) + (separator (magit--propertize-face ":" 'magit-dimmed)) + (deleted (magit--propertize-face "(deleted)" 'magit-dimmed))) + (concat (if cross-repo-p + (concat base-repo separator base-ref) + base-ref) + (magit--propertize-face "..." 'magit-dimmed) + (if cross-repo-p + (if (and head-repo head-ref) + (concat head-repo separator head-ref) + deleted) + (or head-ref deleted))))) + +(defun forge--format-topic-draft (topic) + (if (oref topic draft-p) + (magit--propertize-face "yes" 'bold) + (magit--propertize-face "no" 'magit-dimmed))) + +(defun forge--format-topic-saved (topic) + (if (oref topic saved-p) + (magit--propertize-face "yes" 'bold) + (magit--propertize-face "no" 'magit-dimmed))) + +(defun forge--format-topic-title (topic) + (with-slots (title status state) topic + (magit-log-propertize-keywords + nil + (magit--propertize-face + title + `(,@(and (forge-pullreq-p topic) + (oref topic draft-p) + '(forge-pullreq-draft)) + ,(pcase status + ('unread 'forge-topic-unread) + ('pending 'forge-topic-pending) + ('done 'forge-topic-done)) + ,(pcase (list (eieio-object-class topic) state) + (`(forge-issue open) 'forge-issue-open) + (`(forge-issue completed) 'forge-issue-completed) + (`(forge-issue unplanned) 'forge-issue-unplanned) + (`(forge-pullreq open) 'forge-pullreq-open) + (`(forge-pullreq merged) 'forge-pullreq-merged) + (`(forge-pullreq rejected) 'forge-pullreq-rejected))))))) + +(defun forge--format-topic-milestone (topic) + (and-let* ((id (oref topic milestone)) + (str (caar (forge-sql [:select [title] + :from milestone + :where (= id $s1)] + id)))) + (magit--propertize-face str 'forge-topic-label))) + +(defun forge--format-labels (&optional arg concat) + (and-let* + ((local t) + (labels (cond + ((eieio-object-p arg) + (oref arg labels)) + ((forge-buffer-repository) + (forge-sql-cdr `[:select label:* :from label :where + ,(if arg + '(and (= repository $s1) + (in name $v2)) + '(= repository $s1)) + :order-by [(asc name)]] + forge-buffer-repository + (vconcat arg))) + (t + (setq local nil) + (forge-sql `[:select :distinct name :from label + ,@(and arg '(:where (in name $v1))) + :order-by [(asc name)]] + (vconcat arg))))) + (format (if local + (pcase-lambda (`(,_id ,name ,color ,_description)) + (let* ((background (forge--sanitize-color color)) + (foreground (readable-foreground-color background))) + (magit--propertize-face + name `(( :background ,background + :foreground ,foreground) + forge-topic-label)))) + (pcase-lambda (`(,name)) + (magit--propertize-face name 'forge-topic-label))))) + (if concat + (mapconcat format labels (if (stringp concat) concat " ")) + (mapcar format labels)))) + +(defun forge--format-marks (&optional arg concat) + (and-let* ((marks (if (forge-topic--eieio-childp arg) + (oref arg marks) + ;; Unlike labels, marks are not repo-specific. + (when (forge-repository-p arg) (setq arg nil)) + (forge-sql-cdr `[:select * :from mark + ,@(and arg '(:where (in name $v1))) + :order-by [(asc name)]] + (vconcat arg)))) + (format (pcase-lambda (`(,_id ,name ,face ,_description)) + (magit--propertize-face + name (list face 'forge-topic-label))))) + (if concat + (mapconcat format marks (if (stringp concat) concat " ")) + (mapcar format marks)))) + +(defun forge--format-topic-state (topic) + (with-slots (state) topic + (magit--propertize-face + (symbol-name state) + (pcase (list (if (forge-issue-p topic) 'issue 'pullreq) state) + ('(issue open) 'forge-issue-open) + ('(issue closed) 'forge-issue-completed) + ('(issue completed) 'forge-issue-completed) + ('(issue unplanned) 'forge-issue-unplanned) + ('(pullreq open) 'forge-pullreq-open) + ('(pullreq merged) 'forge-pullreq-merged) + ('(pullreq closed) 'forge-pullreq-rejected))))) + +(defun forge--format-topic-status (topic) + (with-slots (status) topic + (magit--propertize-face + (symbol-name status) + (pcase status + ('unread 'forge-topic-unread) + ('pending 'forge-topic-pending) + ('done 'forge-topic-done))))) + +(defun forge--format-topic-assignees (topic) + (and-let* ((assignees (oref topic assignees))) + (mapconcat #'forge--format-person assignees ", "))) + +(defun forge--format-topic-review-requests (topic) + (and-let* ((review-requests (oref topic review-requests))) + (mapconcat #'forge--format-person review-requests ", "))) + +(defun forge--format-person (person) + (pcase-let ((`(,_id ,login ,name) person)) + (format "%s%s (@%s)" + (forge--format-avatar login) + name login))) + +(defun forge--format-avatar (person) + (if forge-format-avatar-function + (funcall forge-format-avatar-function person) + "")) + +(defun forge--format-boolean (slot name &optional obj) + ;; Booleans are formatted differently in transients and headers. + ;; Use this to format the (complete) description of suffix commands. + (let ((obj (or obj (forge-current-topic)))) + (if (and obj (slot-exists-p obj slot)) + (format (propertize "[%s]" 'face 'transient-delimiter) + (propertize name 'face + (if (eieio-oref obj slot) + 'transient-value + 'transient-inactive-value))) + (format "[%s]" name)))) + +;;; Insert + +(defun forge-insert-topics (type heading prepare) + "Insert a list of topics, according to PREPARE. + +This function is not intended to be added to section hooks directly. +Instead create a function, which calls this function, and add wrapper +to the section hook. + +PREPARE is a function which takes one arguments the repository object, +and must return an filter object of type `forge--topics-spec' or nil. +Insert no topics if PREPARE returns nil, or if the current repository +isn't tracked or Forge hasn't been fully setup yet (in the latter two +cases don't even call PREPARE). + +The filter object can be created either using `forge--topics-spec' or +by `clone'ing the object returned by `forge--init-buffer-topics-spec', +to share some settings with other topic lists in the same buffer. +See `forge--topics-spec' for the valid slots and their values. + +HEADING is used as the heading of the list section and TYPE is used as +its type. TYPE should be a symbol of the form `SUBSET-KIND', where KIND +is one of `topics', `issues' or `pullreqs', and SUBSET should describe +what subset of KIND is being listed." + (declare (indent defun)) + (when-let (((forge-db t)) + (repo (forge-get-repository :tracked?)) + (spec (funcall prepare repo))) + (forge--insert-topics type heading (forge--list-topics spec repo)))) + +(defun forge--insert-topics (type heading topics) + (when topics + (let ((width (apply #'max (--map (length (oref it slug)) topics)))) + (magit-insert-section ((eval type) heading t) + (magit-insert-heading + (concat (magit--propertize-face (concat heading " ") + 'magit-section-heading) + (magit--propertize-face (format "(%s)" (length topics)) + 'magit-section-child-count))) + (magit-insert-section-body + (dolist (topic topics) + (forge--insert-topic topic width)) + (insert ?\n) + (magit-make-margin-overlay nil t)))))) + +(defun forge--insert-topic (topic &optional width) + (magit-insert-section ((eval (oref topic closql-table)) topic t) + (insert (forge--format-topic-line topic (or width 5))) + (forge--insert-topic-marks topic t) + (forge--insert-topic-labels topic t) + (insert "\n") + (magit-log-format-author-margin + (oref topic author) + (format-time-string "%s" (parse-iso8601-time-string (oref topic created))) + t) + (when (and (slot-exists-p topic 'merged) + (not (oref topic merged))) + (magit-insert-heading) + (magit-insert-section-body + (forge--insert-pullreq-commits topic))))) + +(defun forge--insert-topic-labels (topic &optional separate) + (and-let* ((labels (oref topic labels))) + (prog1 t + (pcase-dolist (`(,_id ,name ,color ,description) labels) + (let* ((background (forge--sanitize-color color)) + (foreground (readable-foreground-color background))) + (if separate (insert " ") (setq separate t)) + (insert name) + (let ((o (make-overlay (- (point) (length name)) (point)))) + (overlay-put o 'priority 2) + (overlay-put o 'evaporate t) + (overlay-put o 'font-lock-face + `(( :background ,background + :foreground ,foreground) + forge-topic-label)) + (when description + (overlay-put o 'help-echo description)))))))) + +(defun forge--insert-topic-marks (topic &optional separate) + (and-let* ((marks (oref topic marks))) + (prog1 t + (pcase-dolist (`(,_id ,name ,face ,description) marks) + (if separate (insert " ") (setq separate t)) + (insert name) + (let ((o (make-overlay (- (point) (length name)) (point)))) + (overlay-put o 'priority 2) + (overlay-put o 'evaporate t) + (overlay-put o 'font-lock-face (list face 'forge-topic-label)) + (when description + (overlay-put o 'help-echo description))))))) + +;;; Modes + +(defvar-keymap forge-common-map + :doc "Parent keymap of many of Forge's keymaps. +Keymaps that use this keymap as the/a parent keymap, remap the +place-holder commands `forge--list-menu' and/or `forge--item-menu' +to the appropriate menu command. To change the keys bound to menu +commands in all Forge keymaps, one only has to change them here." + "C-c C-c" #'forge--list-menu + "C-c RET" #'forge--item-menu + "C-" #'forge--item-menu) + +(defun forge--list-menu () + "Place-holder menu command. See `forge-common-map'." + (interactive) + (message "No list menu available here")) +(put 'forge--list-menu 'completion-predicate #'ignore) + +(defun forge--item-menu () + "Place-holder menu command. See `forge-common-map'." + (interactive) + (message "No item menu available here")) +(put 'forge--item-menu 'completion-predicate #'ignore) + +(defvar-keymap forge-post-section-map + " " #'forge-edit-post + "C-c C-k" #'forge-delete-comment) + +(defvar-keymap forge-topic-mode-map + :parent (make-composed-keymap forge-common-map magit-mode-map) + " " #'markdown-follow-link-at-point + "" #'markdown-follow-link-at-point + " " #'forge-topic-menu + " " #'forge-topic-menu + "C-c C-n" #'forge-create-post + "C-c C-r" #'forge-create-post) + +(define-derived-mode forge-topic-mode magit-mode "Topic" + "Parent major mode of `forge-{issue,pullreq}-mode'. +This mode itself is never used directly." + :interactive nil + (face-remap-add-relative 'header-line 'forge-topic-header-line) + (setq-local markdown-translate-filename-function + #'forge--markdown-translate-filename-function)) + +(defvar-keymap forge-issue-mode-map :parent forge-topic-mode-map) +(define-derived-mode forge-issue-mode forge-topic-mode "Issue" + "Major mode for looking at a Forge issue." + :interactive nil) +(defalias 'forge-issue-setup-buffer #'forge-topic-setup-buffer) +(defalias 'forge-issue-refresh-buffer #'forge-topic-refresh-buffer) +(defvar forge-issue-headers-hook + '(forge-insert-topic-state + forge-insert-topic-status + forge-insert-topic-milestone + forge-insert-topic-labels + forge-insert-topic-marks + forge-insert-topic-assignees)) + +(defvar-keymap forge-pullreq-mode-map :parent forge-topic-mode-map) +(define-derived-mode forge-pullreq-mode forge-topic-mode "Pull-request" + "Major mode for looking at a Forge pull-request." + :interactive nil) +(defalias 'forge-pullreq-setup-buffer #'forge-topic-setup-buffer) +(defalias 'forge-pullreq-refresh-buffer #'forge-topic-refresh-buffer) +(defvar forge-pullreq-headers-hook + '(forge-insert-topic-state + forge-insert-topic-draft + forge-insert-topic-status + forge-insert-topic-saved + forge-insert-topic-refs + forge-insert-topic-milestone + forge-insert-topic-labels + forge-insert-topic-marks + forge-insert-topic-assignees + forge-insert-topic-review-requests)) + +(defvar-local forge-buffer-topic nil) + +(defun forge-topic-setup-buffer (topic) + (let* ((repo (forge-get-repository topic)) + (name (format "*forge: %s %s*" (oref repo slug) (oref topic slug))) + (magit-generate-buffer-name-function (lambda (_mode _value) name))) + (magit-setup-buffer-internal + (if (forge-issue-p topic) #'forge-issue-mode #'forge-pullreq-mode) + t `((forge-buffer-topic ,topic)) + name (or (forge-get-worktree repo) "/")) + (forge-topic-mark-read topic))) + +(defun forge-topic-refresh-buffer () + (let ((topic (closql-reload forge-buffer-topic))) + (setq forge-buffer-topic topic) + (magit-set-header-line-format (forge--format-topic-line topic)) + (magit-insert-section (topicbuf) + (magit-insert-headers + (intern (format "%s-headers-hook" + (substring (symbol-name major-mode) 0 -5)))) + (when (forge-pullreq-p topic) + (magit-insert-section (pullreq topic) + (magit-insert-heading "Commits") + (forge--insert-pullreq-commits topic t))) + (when-let ((note (oref topic note))) + (magit-insert-section (note) + (magit-insert-heading "Note") + (insert (forge--fontify-markdown note) "\n\n"))) + (dolist (post (cons topic (oref topic posts))) + (with-slots (author created body) post + (magit-insert-section + ( post post nil + :heading-highlight-face 'magit-diff-hunk-heading-highlight) + (let ((heading + (format-spec + forge-post-heading-format + `((?a . ,(propertize (concat (forge--format-avatar author) + (or author "(ghost)")) + 'font-lock-face 'forge-post-author)) + (?c . ,(propertize created 'font-lock-face 'forge-post-date)) + (?C . ,(propertize (apply #'format "%s %s ago" + (magit--age + (float-time + (date-to-time created)))) + 'font-lock-face 'forge-post-date)))))) + (font-lock-append-text-property + 0 (length heading) + 'font-lock-face 'magit-diff-hunk-heading heading) + (magit-insert-heading heading)) + (insert (forge--fontify-markdown body) "\n\n")))) + (when (and (display-images-p) + (fboundp 'markdown-display-inline-images)) + (let ((markdown-display-remote-images t)) + (markdown-display-inline-images)))))) + +(cl-defmethod magit-buffer-value (&context (major-mode forge-topic-mode)) + (oref forge-buffer-topic slug)) + +;;; Headers + +(cl-defmacro forge--define-topic-header + (name &key insert format (command nil command?)) + (declare (indent defun)) + (let ((fun (intern (format "forge-insert-topic-%s" name))) + (map (intern (format "forge-topic-%s-section-map" name))) + (cmd (intern (format "forge-topic-set-%s" name)))) + `(progn + (cl-defun ,fun (&optional (topic forge-buffer-topic)) + (magit-insert-section (,(intern (format "topic-%s" name))) + (insert ,(capitalize (string-pad (format "%s: " name) 11))) + ,(cond + (insert + `(unless (funcall ,insert topic) + (insert (magit--propertize-face "none" 'magit-dimmed)))) + (format + `(insert (or (funcall ,format topic) + (magit--propertize-face "none" 'magit-dimmed))))) + (insert ?\n))) + ,@(and (if command? command t) + `((defvar-keymap ,map " " + ,(or command `(function ,cmd))) + (put ',fun 'definition-name ',name))) + (put ',map 'definition-name ',name)))) + +(forge--define-topic-header refs + :command nil + :format #'forge--format-topic-refs) + +(forge--define-topic-header draft + :command #'forge-topic-toggle-draft + :format #'forge--format-topic-draft) + +(forge--define-topic-header saved + :command #'forge-topic-toggle-saved + :format #'forge--format-topic-saved) + +(forge--define-topic-header state + :command #'forge-topic-state-menu + :format #'forge--format-topic-state) + +(forge--define-topic-header status + :command #'forge-topic-status-menu + :format #'forge--format-topic-status) + +(forge--define-topic-header milestone + :format #'forge--format-topic-milestone) + +(forge--define-topic-header labels + :insert #'forge--insert-topic-labels) + +(forge--define-topic-header marks + :insert #'forge--insert-topic-marks) + +(forge--define-topic-header assignees + :format #'forge--format-topic-assignees) + +(forge--define-topic-header review-requests + :format #'forge--format-topic-review-requests) + +;;; Commands +;;;; Groups + +(defconst forge--lists-group + ["List" + ("l r" "repositories" forge-list-repositories) + ("l n" "notifications" forge-list-notifications) + ("l g" "global topics" forge-list-global-topics) + ("l t" "topics" forge-list-topics) + ""]) + +(defconst forge--topic-menus-group + ["Menu" + ("m s" "edit" forge-topic-menu) + ("m f" "filter" forge-topics-menu) + ("m f" "filter" forge-notifications-menu) + ("m f" "filter" forge-repositories-menu) + ("m d" "dispatch" forge-dispatch) + ("m c" "configure" forge-configure) + ""]) + +(defconst forge--topic-set-state-group + [:description + (lambda () (if forge--show-topic-legend "Set public state" "Set state")) + ("o" forge-topic-state-set-open) + ("c" forge-issue-state-set-completed) + ("x" forge-issue-state-set-unplanned) + ("c" forge-pullreq-state-set-merged) + ("x" forge-pullreq-state-set-rejected)]) + +(defconst forge--topic-set-status-group + [:description + (lambda () (if forge--show-topic-legend "Set private status" "Set status")) + ("u" forge-topic-status-set-unread) + ("p" forge-topic-status-set-pending) + ("d" forge-topic-status-set-done)]) + +(defconst forge--topic-legend-group + '(["Legend" :if-non-nil forge--show-topic-legend + (:info* (lambda () (propertize "open issue" 'face 'forge-issue-open))) + (:info* (lambda () (propertize "completed issue" 'face 'forge-issue-completed))) + (:info* (lambda () (propertize "unplanned issue" 'face 'forge-issue-unplanned)))] + ["" :if-non-nil forge--show-topic-legend + (:info* (lambda () (propertize "open pullreq" 'face 'forge-pullreq-open))) + (:info* (lambda () (propertize "merged pullreq" 'face 'forge-pullreq-merged))) + (:info* (lambda () (propertize "rejected pullreq" 'face 'forge-pullreq-rejected)))] + ["" :if-non-nil forge--show-topic-legend + (:info* (lambda () (propertize "unread" 'face 'forge-topic-unread))) + (:info* (lambda () (propertize "pending" 'face 'forge-topic-pending))) + (:info* (lambda () (propertize "done" 'face 'forge-topic-done)))] + ["" :if-non-nil forge--show-topic-legend + (:info* (lambda () (propertize "draft" 'face 'forge-pullreq-draft)))])) + +(defvar forge--show-topic-legend t) + +(transient-define-suffix forge-toggle-topic-legend () + "Toggle whether to show legend for faces used in topic menus and lists." + :description (lambda () (if forge--show-topic-legend "hide legend" "show legend")) + :transient t + (interactive) + (customize-set-variable 'forge--show-topic-legend + (not forge--show-topic-legend))) + +(defconst forge--topic-menus-column-widths '(21 21 21 21)) + +;;;; Menus + +;;;###autoload(autoload 'forge-topic-menu "forge-topic" nil t) +(transient-define-prefix forge-topic-menu () + "Edit the topic at point." + :transient-suffix t + :transient-non-suffix #'transient--do-call + :transient-switch-frame nil + :refresh-suffixes t + :environment #'forge--menu-environment + :column-widths forge--topic-menus-column-widths + [:hide always ("q" forge-menu-quit-list)] + [forge--topic-menus-group + forge--topic-set-state-group + forge--topic-set-status-group + ["Actions" + ("/f" forge-pull-this-topic) + ("/b" forge-browse-this-topic) + ("/c" forge-checkout-this-pullreq)]] + [forge--lists-group + ["Set " + ("-m" forge-topic-set-milestone) + ("-l" forge-topic-set-labels) + ("-x" forge-topic-set-marks) + ("-a" forge-topic-set-assignees) + ("-r" forge-topic-set-review-requests) + ("-n" forge-edit-topic-note) + ("-t" forge-topic-set-title)] + ["Set" + ("-s" forge-topic-toggle-saved) + ("-d" forge-topic-toggle-draft) + """Display" + ("-H" forge-toggle-topic-legend)]] + [forge--topic-legend-group]) + +(transient-augment-suffix forge-topic-menu + :transient #'transient--do-replace + :inapt-if (lambda () (or (derived-mode-p 'forge-repository-list-mode) + (eq (oref transient--prefix command) 'forge-topic-menu))) + :inapt-face (lambda () (if (derived-mode-p 'forge-repository-list-mode) + 'transient-inapt-suffix + 'forge-suffix-active))) + +;;;###autoload(autoload 'forge-topic-state-menu "forge-topic" nil t) +(transient-define-prefix forge-topic-state-menu () + "Set state of the current topic." + :environment #'forge--menu-environment + [forge--topic-set-state-group]) + +;;;###autoload(autoload 'forge-topic-status-menu "forge-topic" nil t) +(transient-define-prefix forge-topic-status-menu () + "Set status of the current topic." + :environment #'forge--menu-environment + [forge--topic-set-status-group]) + +(defun forge--menu-environment (fn) + (let ((magit--refresh-cache (list (cons 0 0)))) + (funcall fn))) + +;;;; State + +(defclass forge--topic-set-state-command (transient-suffix) + ((state :initarg :state) + (getter :initarg :getter) + (definition + :initform (lambda () + (interactive) + (with-slots (getter state) (transient-suffix-object) + (let ((topic (funcall getter t))) + (forge--set-topic-state (forge-get-repository topic) + topic state))))) + (description + :initform (lambda (obj) + (symbol-name (oref obj state)))) + (inapt-if + :initform (lambda () + (or (forge-region-topics) + (with-slots (getter state) (transient-suffix-object) + (if-let ((topic (funcall getter))) + ;; Once a pull-request is merged, + ;; its state cannot be changed anymore. + (memq (oref topic state) (list state 'merged)) + t))))) + (inapt-face + :initform (lambda (obj) + (with-slots (getter state) (transient-suffix-object) + (if (and (not (forge-region-topics)) + (and-let* ((topic (funcall getter))) + (eq (oref topic state) state))) + 'forge-suffix-active + 'transient-inapt-suffix)))))) + +(transient-define-suffix forge-topic-state-set-open () + "Set the state of the current topic to `open'." + :class 'forge--topic-set-state-command + :state 'open + :getter #'forge-current-topic) + +(transient-define-suffix forge-issue-state-set-completed () + "Set the state of the current issue to `completed'." + :class 'forge--topic-set-state-command + :state 'completed + :getter #'forge-current-issue) + +(transient-define-suffix forge-issue-state-set-unplanned () + "Set the state of the current issue to `unplanned'." + :class 'forge--topic-set-state-command + :state 'unplanned + :getter #'forge-current-issue) + +(transient-define-suffix forge-pullreq-state-set-merged () + "If the current pull-request is merged, then visualize that." + :class 'forge--topic-set-state-command + :state 'merged + :getter #'forge-current-pullreq + (interactive) + (message "Please use a merge command for this")) + +(transient-define-suffix forge-pullreq-state-set-rejected () + "Set the state of the current pull-request to `rejected'." + :class 'forge--topic-set-state-command + :state 'rejected + :getter #'forge-current-pullreq) + +;;;; Status + +(defclass forge--topic-set-status-command (transient-suffix) + ((status :initarg :status) + (definition + :initform (lambda () + (interactive) + (with-slots (status) (transient-suffix-object) + (if-let ((topics (forge-region-topics))) + (dolist (topic topics) + (oset topic status status)) + (oset (forge-current-topic t) status status))) + (forge-refresh-buffer))) + (description + :initform (lambda (obj) + (symbol-name (oref obj status)))) + (inapt-if + :initform (lambda () + (and (not (forge-region-topics)) + (if-let ((topic (forge-current-topic))) + (eq (oref topic status) + (oref (transient-suffix-object) status)) + t)))) + (inapt-face + :initform (lambda () + (if (forge-current-topic) + 'forge-suffix-active + 'transient-inapt-suffix))))) + +(transient-define-suffix forge-topic-status-set-unread () + "Set the notification status of the current topic to `unread'." + :class 'forge--topic-set-status-command :status 'unread) + +(transient-define-suffix forge-topic-status-set-pending () + "Set the notification status of the current topic to `pending'." + :class 'forge--topic-set-status-command :status 'pending) + +(transient-define-suffix forge-topic-status-set-done () + "Set the notification status of the current topic to `done'." + :class 'forge--topic-set-status-command :status 'done) + +;;;; Set + +(defclass forge--topic-set-slot-command (transient-suffix) + ((slot :initarg :slot) + (setter) + (reader) + (formatter :initarg :formatter) + (definition + :initform (lambda (value) + (interactive + (list (funcall (oref (transient-suffix-object) reader) + (forge-current-topic t)))) + (let ((topic (forge-current-topic t))) + (funcall (oref (transient-suffix-object) setter) + (forge-get-repository topic) + topic value)))) + (description + :initform (lambda (obj) + (with-slots (slot inapt-if-not) obj + (if-let* ((topic (if inapt-if-not + (funcall inapt-if-not) + (forge-current-topic))) + (value (funcall (oref obj formatter) topic))) + (format "%s %s" slot value) + (format "%s" slot))))))) + +(cl-defmethod initialize-instance :after + ((obj forge--topic-set-slot-command) &optional _slots) + (with-slots (slot) obj + (let ((name (symbol-name slot))) + (cond ((string-suffix-p "-p" name) + (setq name (substring name 0 -2)) + (oset obj reader (lambda (topic) (not (eieio-oref topic slot))))) + ((oset obj reader (intern (format "forge-read-topic-%s" name))))) + (oset obj setter (intern (format "forge--set-topic-%s" name))) + (unless (slot-boundp obj 'formatter) + (oset obj formatter (intern (format "forge--format-topic-%s" name))))))) + +(transient-define-suffix forge-topic-set-title (title) + "Edit the TITLE of the current topic." + :class 'forge--topic-set-slot-command :slot 'title + :formatter (lambda (topic) + (propertize (truncate-string-to-width + (forge--format-topic-title topic) 34 nil ?\s t) + 'face 'font-lock-string-face))) + +(transient-define-suffix forge-topic-set-milestone (milestone) + "Edit what MILESTONE the current topic belongs to." + :class 'forge--topic-set-slot-command :slot 'milestone) + +(transient-define-suffix forge-topic-set-labels (labels) + "Edit the LABELS of the current topic." + :class 'forge--topic-set-slot-command :slot 'labels + :formatter (lambda (topic) (forge--format-labels topic t))) + +(transient-define-suffix forge-topic-set-marks (marks) + "Edit the MARKS of the current topic." + :class 'forge--topic-set-slot-command :slot 'marks + :formatter (lambda (topic) (forge--format-marks topic t))) + +(transient-define-suffix forge-topic-set-assignees (assignees) + "Edit the ASSIGNEES of the current topic." + :class 'forge--topic-set-slot-command :slot 'assignees) + +(transient-define-suffix forge-topic-set-review-requests (review-requests) + "Edit the REVIEW-REQUESTS of the current pull-request." + :class 'forge--topic-set-slot-command :slot 'review-requests + :inapt-if-not #'forge-current-pullreq) + +(transient-define-suffix forge-topic-toggle-draft (draft) + "Toggle whether the current pull-request is a draft." + :class 'forge--topic-set-slot-command :slot 'draft-p + :inapt-if-not #'forge-current-pullreq + :description (lambda () (forge--format-boolean 'draft-p "draft"))) + +(transient-define-suffix forge-topic-toggle-saved () + "Toggle whether this topic is marked as saved." + :class 'forge--topic-set-slot-command :slot 'saved-p + :description (lambda () (forge--format-boolean 'saved-p "saved")) + ;; Set only locally because Github's API does not support this. + (interactive) + (let ((topic (forge-current-topic t))) + (oset topic saved-p (not (oref topic saved-p)))) + (forge-refresh-buffer)) + +;;; Color Utilities + +(defun forge--sanitize-color (color) + (cond ((color-values color) color) + ;; Discard alpha information. + ((string-match-p "\\`#.\\{4\\}\\'" color) (substring color 0 3)) + ((string-match-p "\\`#.\\{8\\}\\'" color) (substring color 0 6)) + (t "#000000"))) ; Use fallback instead of invalid color. + +;;; Markdown Utilities + +(defun forge--fontify-markdown (text) + (with-temp-buffer + (delay-mode-hooks + (gfm-mode)) + (insert text) + (font-lock-ensure) + (when forge-post-fill-region + (fill-region (point-min) (point-max))) + (buffer-string))) + +(defun forge--markdown-translate-filename-function (file) + (if (string-match-p "\\`https?://" file) + file + (let ((host (oref (forge-get-repository :tracked) forge))) ;aka webhost + (concat (if (member host ghub-insecure-hosts) "http://" "https://") + host + (and (not (string-prefix-p "/" file)) "/") + file)))) + +;;; Templates + +(defun forge--topic-parse-buffer (&optional file) + (save-match-data + (save-excursion + (goto-char (point-min)) + (let ((alist (save-excursion (forge--topic-parse-yaml)))) + (if alist + (setf (alist-get 'yaml alist) t) + (setq alist (save-excursion (forge--topic-parse-plain)))) + (setf (alist-get 'file alist) file) + (setf (alist-get 'text alist) (magit--buffer-string nil nil ?\n)) + (when (and file (not (alist-get 'prompt alist))) + (setf (alist-get 'prompt alist) + (file-name-sans-extension (file-name-nondirectory file)))) + ;; If there is a yaml front-matter, then it is supposed + ;; to have a `title' field, but this may not be the case. + (when (and (not file) + (not (alist-get 'title alist))) + (setf (alist-get 'title alist) + (read-string "Title: "))) + alist)))) + +(defun forge--topic-parse-yaml () + (let (alist beg end) + (when (looking-at "^---[\s\t]*$") + (forward-line) + (setq beg (point)) + (when (re-search-forward "^---[\s\t]*$" nil t) + (setq end (match-beginning 0)) + (setq alist (yaml-parse-string + (buffer-substring-no-properties beg end) + :object-type 'alist + :sequence-type 'list + ;; FIXME Does not work because of + ;; https://github.com/zkry/yaml.el/pull/28. + :false-object nil)) + (let-alist alist + (when (and .name .about) + (setf (alist-get 'prompt alist) + (format "[%s] %s" .name .about))) + (when (and .labels (atom .labels)) + (setf (alist-get 'labels alist) (list .labels))) + (when (and .assignees (atom .assignees)) + (setf (alist-get 'assignees alist) (list .assignees)))) + (forward-line) + (when (and (not (alist-get 'title alist)) + (looking-at "^\n?#*")) + (goto-char (match-end 0)) + (setf (alist-get 'title alist) + (string-trim + (magit--buffer-string (point) (line-end-position) t))) + (forward-line)) + (setf (alist-get 'body alist) + (string-trim (magit--buffer-string (point) nil ?\n))))) + alist)) + +(defun forge--topic-parse-plain () + (let (title body) + (when (looking-at "\\`#*") + (goto-char (match-end 0))) + (setq title (magit--buffer-string (point) (line-end-position) t)) + (forward-line) + (setq body (magit--buffer-string (point) nil ?\n)) + `((title . ,(string-trim title)) + (body . ,(string-trim body))))) + +(defun forge--topic-parse-link-buffer () + (save-match-data + (save-excursion + (goto-char (point-min)) + (mapcar (lambda (alist) + (cons (cons 'prompt (concat (alist-get 'name alist) " -- " + (alist-get 'about alist))) + alist)) + (forge--topic-parse-yaml-links))))) + +(defun forge--topic-parse-yaml-links () + (alist-get 'contact_links + (yaml-parse-string (buffer-substring-no-properties + (point-min) + (point-max)) + :object-type 'alist + :sequence-type 'list))) + +(cl-defgeneric forge--topic-template-files (repo class) + "Return a list of topic template files for REPO and a topic of CLASS.") + +(cl-defgeneric forge--topic-template (repo class) + "Return a topic template alist for REPO and a topic of CLASS. +If there are multiple templates, then the user is asked to select +one of them. It there are no templates, then return a very basic +alist, containing just `text' and `position'.") + +(defun forge--topic-templates-data (repo class) + (let ((branch (oref repo default-branch))) + (mapcan (lambda (f) + (with-temp-buffer + (magit-git-insert "cat-file" "-p" (concat branch ":" f)) + (if (equal (file-name-nondirectory f) "config.yml") + (forge--topic-parse-link-buffer) + (list (forge--topic-parse-buffer f))))) + (forge--topic-template-files repo class)))) + +(cl-defmethod forge--topic-template ((repo forge-repository) + (class (subclass forge-topic))) + (let ((choices (forge--topic-templates-data repo class))) + (if (cdr choices) + (let ((c (magit-completing-read + (if (eq class 'forge-pullreq) + "Select pull-request template" + "Select issue template") + (--map (alist-get 'prompt it) choices) + nil t))) + (--first (equal (alist-get 'prompt it) c) choices)) + (car choices)))) + +;;; Bug-Reference + +(defun forge-bug-reference-setup () + "Setup `bug-reference' in the current buffer. +If forge data has been fetched for the current repository, then +enable `bug-reference-mode' or `bug-reference-prog-mode' and +modify `bug-reference-bug-regexp' if appropriate." + (unless (or bug-reference-url-format + (not (forge-db t)) + ;; TODO Allow use in these modes again. + (derived-mode-p 'forge-topics-mode 'forge-notifications-mode)) + (magit--with-safe-default-directory nil + (when-let ((repo (forge-get-repository :tracked?))) + (when (derived-mode-p 'magit-status-mode + 'forge-notifications-mode) + (setq-local + bug-reference-auto-setup-functions + (let ((hook bug-reference-auto-setup-functions)) + (list (lambda () + ;; HOOK is not allowed to be a lexical var: + ;; (run-hook-with-args-until-success 'hook) + (catch 'success + (dolist (f hook) + (when (funcall f) + (setq bug-reference-bug-regexp + (concat "." bug-reference-bug-regexp)) + (throw 'success t))))))))) + (if (derived-mode-p 'prog-mode) + (bug-reference-prog-mode 1) + (bug-reference-mode 1)) + (add-hook 'completion-at-point-functions + #'forge-topic-completion-at-point nil t))))) + +(unless noninteractive + (dolist (hook forge-bug-reference-hooks) + (add-hook hook #'forge-bug-reference-setup))) + +;;; _ +(provide 'forge-topic) +;;; forge-topic.el ends here diff --git a/elpa/forge-20241218.2036/forge-topics.el b/elpa/forge-20241218.2036/forge-topics.el new file mode 100644 index 00000000..2b6dedf9 --- /dev/null +++ b/elpa/forge-20241218.2036/forge-topics.el @@ -0,0 +1,619 @@ +;;; 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 'forge-topic) + +;;; Options + +(defcustom forge-list-buffer-default-topic-filters + (forge--topics-spec :type 'topic :active t :state 'open :order 'newest) + "Filters initially used to limit topics listed in list buffers. + +This option controls which topics are listed when initially creating +a `forge-topics-mode' buffer. To temporarily change which topics are +listed in a given buffer, instead use \\`N m' (`forge-topics-menu')." + :package-version '(forge . "0.4.0") + :group 'forge + :type 'object) + +(defcustom forge-status-buffer-default-topic-filters + (forge--topics-spec :type 'topic :active t :state 'open :order 'newest) + "Filters initially used to limit topics listed in status buffers. + +This option controls which topics are listed when initially creating +a `magit-status-mode' buffer. To temporarily change which topics are +listed in a given buffer, instead use \\ \ +\\[forge-topics-menu] (`forge-topics-menu'). + +To initially list no topics, set the `type' slot to nil." + :package-version '(forge . "0.4.0") + :group 'forge + :type 'object) + +(defcustom forge-owned-accounts nil + "An alist of accounts that are owned by you. +This should include your username as well as any organization +that you own. Used by the commands `forge-list-owned-issues', +`forge-list-owned-pullreqs' and `forge-fork'. + +Each element has the form (ACCOUNT . PLIST). The following +properties are currently being used: + +`remote-name' The default name suggested by `forge-fork' for a + fork created within this account. If unspecified, then the + name of the account is used." + :package-version '(forge . "0.2.0") + :group 'forge + :type '(repeat (cons (string :tag "Account") plist))) + +(defcustom forge-owned-ignored nil + "A list of repositories that are ignored when listing those owned by you. +This is a list of package names. Used by the commands +`forge-list-owned-issues' and `forge-list-owned-pullreqs'." + :package-version '(forge . "0.2.0") + :group 'forge + :type '(repeat (string :tag "Name"))) + +;;; Faces + +(defface forge-suffix-active + '((t :inherit transient-value :weight bold)) + "Face used for suffixes whose effects is currently active." + :group 'forge-faces) + +(defface forge-suffix-active-and-implied + '((t :inherit transient-value :weight semibold)) + "Face used for suffixes whose effects is currently active and implied." + :group 'forge-faces) + +(defface forge-suffix-implied + '((t :inherit transient-value :weight normal)) + "Face used for suffixes whose effects is currently implied." + :group 'forge-faces) + +;;; Mode + +(defvar-keymap forge-topics-mode-map + :doc "Local keymap for Forge-Topic-List mode buffers." + :parent (make-composed-keymap forge-common-map magit-mode-map) + "RET" #'forge-visit-this-topic + "" #'forge-visit-this-topic + "o" #'forge-browse-this-topic + " " #'forge-topics-menu + " " #'forge-topic-menu + " " #'forge-refresh-buffer) + +(defvar forge-topics-mode-name '((:eval (forge-topics-buffer-desc))) + "Information shown in the mode-line for `forge-topics-mode'. +Must be set before `forge-topics' is loaded.") + +(define-derived-mode forge-topics-mode magit-mode forge-topics-mode-name + "Major mode for browsing a list of topics." + :interactive nil + (magit-hack-dir-local-variables)) + +(defun forge-topics-setup-buffer (&optional repo spec &rest params) + (let* ((global (or (plist-get params :global) + (and spec (oref spec global)))) + (repo (or repo + (and (not global) + (if-let* ((topic (forge-topic-at-point)) + (repo (forge-get-repository topic))) + repo + (forge-get-repository :tracked?))))) + (dir (or (and repo (forge-get-worktree repo)) "/")) + (buf (forge-topics-buffer-name repo)) + (buf (or (get-buffer buf) buf)) + (spec (cond (spec (clone spec)) + ((and (bufferp buf) + (buffer-local-value 'forge--buffer-topics-spec buf))) + ((clone forge-list-buffer-default-topic-filters))))) + (while-let ((key (pop params))) + (eieio-oset spec key (pop params))) + (unless (oref spec type) + (oset spec type 'topic)) + (unless (or repo global) + (error "Cannot determine repository")) + (magit-setup-buffer-internal #'forge-topics-mode nil + `((forge-buffer-repository + ,(and repo (oref repo id))) + (forge--buffer-topics-spec ,spec) + (forge-buffer-unassociated-p ,global)) + (get-buffer-create buf) + dir))) + +(defun forge-topics-refresh-buffer () + (magit-set-header-line-format (forge-topics-buffer-desc)) + (let ((topics (forge--list-topics + forge--buffer-topics-spec + (forge-get-repository :tracked?)))) + (magit-insert-section (topicbuf) + (cond + ((not topics) + (insert "No matching topics\n")) + ((not (oref forge--buffer-topics-spec grouped)) + (dolist (topic topics) + (forge--insert-topic topic 5))) + ((pcase-dolist (`(,_ . ,topics) + (--group-by (oref it repository) topics)) + (let ((repo (forge-get-repository (car topics)))) + (magit-insert-section (forge-repo repo) + (magit-insert-heading + (concat (propertize (format "%s/%s" + (oref repo owner) + (oref repo name)) + 'font-lock-face 'bold) + (format " (%s)" (length topics)))) + (dolist (topic topics) + (forge--insert-topic topic 5)))))))))) + +(defun forge-topics-buffer-desc () + (capitalize (concat (symbol-name (oref forge--buffer-topics-spec type)) "s"))) + +(defun forge-topics-buffer-name (&optional repo) + (if repo + (format "*forge-topics: %s*" (oref repo slug)) + "*forge-topics*")) + +;;; Commands +;;;; Menu + +;;;###autoload(autoload 'forge-topics-menu "forge-topics" nil t) +(transient-define-prefix forge-topics-menu () + "Control list of topics displayed in the current buffer." + :transient-suffix t + :transient-non-suffix #'transient--do-call + :transient-switch-frame nil + :refresh-suffixes t + :environment #'forge--menu-environment + :column-widths forge--topic-menus-column-widths + [:hide always ("q" forge-menu-quit-list)] + [forge--topic-menus-group + ["State" + ("a" forge-topics-filter-active) + ("o" forge-topics-filter-state-open) + ("c" forge-topics-filter-state-completed) + ("x" forge-topics-filter-state-unplanned)] + ["Status" + ("i" forge-topics-filter-status-inbox) + ("u" forge-topics-filter-status-unread) + ("p" forge-topics-filter-status-pending) + ("d" forge-topics-filter-status-done)] + ["Type" + ("t t" forge-topics-all-types) + ("t i" forge-topics-filter-issues) + ("t p" forge-topics-filter-pullreqs)]] + [forge--lists-group + ["Filter " + ("-m" forge-topics-filter-milestone) + ("-l" forge-topics-filter-labels) + ("-x" forge-topics-filter-marks) + ("-c" forge-topics-filter-author) + ("-a" forge-topics-filter-assignee) + ("-r" forge-topics-filter-reviewer) + ("-s" forge-topics-filter-saved)] + ["Display" + ("-O" forge-topics-set-order) + ("-L" forge-topics-set-limit) + ("-F" forge-topics-ungroup) + ("-G" forge-topics-group) + ("-S" forge-toggle-display-in-status-buffer) + ("-H" forge-toggle-topic-legend)]] + [forge--topic-legend-group] + (interactive) + (cond ((derived-mode-p 'forge-topics-mode 'magit-status-mode) + (transient-setup 'forge-topics-menu)) + ((derived-mode-p 'forge-notifications-mode) + (setq this-command 'forge-notifications-menu) + (transient-setup 'forge-notifications-menu)) + ((forge-list-topics)))) + +(transient-augment-suffix forge-topics-menu + :transient #'transient--do-replace + :if-not-derived '(forge-notifications-mode forge-repository-list-mode) + :inapt-if (lambda () (eq (oref transient--prefix command) 'forge-topics-menu)) + :inapt-face 'forge-suffix-active) + +(defvar-local forge--quit-keep-topic-menu nil) + +(defun forge-menu-quit-list () + "From a transient menu, quit the list buffer and the menu. + +If quitting the list buffer causes another topic, repository list or +notification list buffer to become current in the selected window, +then display the respective menu, otherwise display no menu." + (interactive) + (let ((keep-topic-menu forge--quit-keep-topic-menu)) + (when (derived-mode-p 'forge-topic-mode + 'forge-topics-mode + 'forge-repository-list-mode + 'forge-notifications-mode) + (kill-local-variable 'forge--quit-keep-topic-menu) + (quit-window)) + (cond ((derived-mode-p 'forge-topic-mode) + (setq transient--exitp 'replace) + (transient-setup (setq this-command 'forge-topic-menu))) + ((derived-mode-p 'forge-topics-mode) + (unless keep-topic-menu + (setq transient--exitp 'replace) + (transient-setup (setq this-command 'forge-topics-menu)))) + ((derived-mode-p 'forge-repository-list-mode) + (setq transient--exitp 'replace) + (transient-setup (setq this-command 'forge-repositories-menu))) + ((derived-mode-p 'forge-notifications-mode) + (setq transient--exitp 'replace) + (transient-setup (setq this-command 'forge-notifications-menu))) + (t + (setq transient--exitp t) + (transient--pre-exit) + (transient--stack-zap))))) + +;;;; List + +;;;###autoload(autoload 'forge-list-topics "forge-topics" nil t) +(transient-define-suffix forge-list-topics (&optional repo) + "List topics of the current repository." + :description "topics" + :inapt-if (lambda () (or (not (forge--get-repository:tracked?)) + (and (eq major-mode 'forge-topics-mode) + (not (oref forge--buffer-topics-spec global))))) + :inapt-face (lambda () (if (not (forge--get-repository:tracked?)) + 'transient-inapt-suffix + 'forge-suffix-active)) + (declare (interactive-only nil)) + (interactive) + (forge-topics-setup-buffer repo) + (transient-setup 'forge-topics-menu)) + +;;;###autoload(autoload 'forge-list-issues "forge-topics" nil t) +(transient-define-suffix forge-list-issues (&optional repo) + "List issues of the current repository." + :description "issues" + (declare (interactive-only nil)) + (interactive) + (forge-topics-setup-buffer repo nil :type 'issue) + (transient-setup 'forge-topics-menu)) + +;;;###autoload(autoload 'forge-list-pullreqs "forge-topics" nil t) +(transient-define-suffix forge-list-pullreqs (&optional repo) + "List pull-requests of the current repository." + :description "pull-requests" + (declare (interactive-only nil)) + (interactive) + (forge-topics-setup-buffer repo nil :type 'pullreq) + (transient-setup 'forge-topics-menu)) + +;;;###autoload(autoload 'forge-list-global-topics "forge-topics" nil t) +(transient-define-suffix forge-list-global-topics (&optional repo) + "List topics across all tracked repository." + :description "topics" + :inapt-if (lambda () (and (eq major-mode 'forge-topics-mode) + (oref forge--buffer-topics-spec global))) + :inapt-face 'forge-suffix-active + (declare (interactive-only nil)) + (interactive) + (forge-topics-setup-buffer repo nil :global t) + (transient-setup 'forge-topics-menu)) + +;;;###autoload(autoload 'forge-list-global-issues "forge-topics" nil t) +(transient-define-suffix forge-list-global-issues (&optional repo) + "List issues across all tracked repository." + :description "issues" + (declare (interactive-only nil)) + (interactive) + (forge-topics-setup-buffer repo nil :global t :type 'issue) + (transient-setup 'forge-topics-menu)) + +;;;###autoload(autoload 'forge-list-global-pullreqs "forge-topics" nil t) +(transient-define-suffix forge-list-global-pullreqs (&optional repo) + "List pull-requests across all tracked repository." + :description "pull-requests" + (declare (interactive-only nil)) + (interactive) + (forge-topics-setup-buffer repo nil :global t :type 'pullreq) + (transient-setup 'forge-topics-menu)) + +;;;; Type + +(defclass forge--topics-filter-type-command (transient-suffix) + ((type :initarg :type) + (definition + :initform (lambda (&optional repo) + (interactive) + (oset forge--buffer-topics-spec type + (oref (transient-suffix-object) type)) + (forge-refresh-buffer))) + (inapt-face :initform 'forge-suffix-active) + (inapt-if + :initform (lambda () + (eq (oref forge--buffer-topics-spec type) + (oref (transient-suffix-object) type)))))) + +(transient-define-suffix forge-topics-all-types () + :class 'forge--topics-filter-type-command :type 'topic + :description "topics") + +(transient-define-suffix forge-topics-filter-issues () + "List issues of the current repository." + :class 'forge--topics-filter-type-command :type 'issue + :description "issues") + +(transient-define-suffix forge-topics-filter-pullreqs () + "List pull-requests of the current repository." + :class 'forge--topics-filter-type-command :type 'pullreq + :description "pull-requests") + +;;;; Active + +(transient-define-suffix forge-topics-filter-active () + "Limit topic list to active topics." + :description "active" + :face (lambda () + (and (oref forge--buffer-topics-spec active) + 'forge-suffix-active)) + (interactive) + (oset forge--buffer-topics-spec active + (not (oref forge--buffer-topics-spec active))) + (forge-refresh-buffer)) + +;;;; State + +(defclass forge--topics-filter-state-command (transient-suffix) + ((state :initarg :state) + (definition + :initform (lambda () + (interactive) + (let ((want (oref (transient-suffix-object) state)) + (spec forge--buffer-topics-spec)) + (cond ((and (eq want 'open) + (oref spec active)) + (oset spec active nil) + (oset spec state want)) + ((equal (oref spec state) want) + (oset spec state nil)) + (t + (oset spec active nil) + (oset spec state want)))) + (forge-refresh-buffer))) + (description + :initform (lambda (suffix) + (let ((want (oref suffix state)) + (type (oref forge--buffer-topics-spec type))) + (pcase type + ((guard (atom want)) + (symbol-name want)) + ('topic (apply #'format "%s/%s" want)) + ('issue (symbol-name (car want))) + ('pullreq (symbol-name (cadr want))))))) + (face + :initform (lambda (suffix) + (let ((want (oref suffix state)) + (have (oref forge--buffer-topics-spec state)) + (active (oref forge--buffer-topics-spec active))) + (cond ((and (not active) + (equal have want)) + 'forge-suffix-active) + ((and (or active + (eq have 'open)) + (eq want 'open)) + (if (eq have want) + 'forge-suffix-active-and-implied + 'forge-suffix-implied)))))))) + +(transient-define-suffix forge-topics-filter-state-open () + "Limit topic list to open topics." + :class 'forge--topics-filter-state-command :state 'open) + +(transient-define-suffix forge-topics-filter-state-completed () + "Limit topic list to completed and merged topics." + :class 'forge--topics-filter-state-command :state '(completed merged)) + +(transient-define-suffix forge-topics-filter-state-unplanned () + "Limit topic list to unplanned and rejected topics." + :class 'forge--topics-filter-state-command :state '(unplanned rejected)) + +;;;; Status + +(defclass forge--topics-filter-status-command (transient-suffix) + ((status :initarg :status) + (definition + :initform (lambda () + (interactive) + (let* ((want (oref (transient-suffix-object) status)) + (spec forge--buffer-topics-spec) + (have (oref spec status)) + (active (oref spec active))) + (cond (active + (oset spec active nil) + (oset spec status want)) + ((eq have want) + (oset spec status nil)) + ((oset spec status want)))) + (forge-refresh-buffer))) + (description + :initform (lambda (suffix) (symbol-name (oref suffix status)))) + (face + :initform (lambda (suffix) + (let ((want (oref suffix status)) + (have (oref forge--buffer-topics-spec status)) + (active (oref forge--buffer-topics-spec active))) + (cond ((and (not active) + (equal have want)) + 'forge-suffix-active) + ((and (or active + (eq have 'inbox)) + (memq want '(inbox unread pending))) + (if (eq have want) + 'forge-suffix-active-and-implied + 'forge-suffix-implied)))))))) + +(transient-define-suffix forge-topics-filter-status-inbox () + "Limit topic list to unread and pending topics." + :class 'forge--topics-filter-status-command :status 'inbox) + +(transient-define-suffix forge-topics-filter-status-unread () + "Limit topic list to unread topics." + :class 'forge--topics-filter-status-command :status 'unread) + +(transient-define-suffix forge-topics-filter-status-pending () + "Limit topic list to pending topics." + :class 'forge--topics-filter-status-command :status 'pending) + +(transient-define-suffix forge-topics-filter-status-done () + "Limit topic list to done topics." + :class 'forge--topics-filter-status-command :status 'done) + +;;;; Filter + +(defclass forge--topics-filter-command (transient-suffix) + ((slot :initarg :slot) + (reader :initarg :reader) + (formatter :initarg :formatter :initform nil) + (definition + :initform (lambda () + (interactive) + (with-slots (slot reader) (transient-suffix-object) + (eieio-oset forge--buffer-topics-spec slot + (if (eieio-oref forge--buffer-topics-spec slot) + nil + (funcall reader))) + (forge-refresh-buffer)))) + (description + :initform (lambda (obj) + (with-slots (slot formatter) obj + (let ((value (eieio-oref forge--buffer-topics-spec slot))) + (if value + (format "%s %s" slot + (if formatter + (funcall formatter value) + (propertize (format "%s" value) + 'face 'forge-suffix-active))) + (format "%s" slot)))))))) + +(cl-defmethod initialize-instance :after + ((obj forge--topics-filter-command) &optional _slots) + (unless (slot-boundp obj 'reader) + (oset obj reader (intern (format "forge-read-topic-%s" (oref obj slot)))))) + +(transient-define-suffix forge-topics-filter-milestone () + "Read a milestone and limit topic list to topics with that milestone." + :class 'forge--topics-filter-command + :slot 'milestone + :formatter (lambda (m) (propertize m 'face 'forge-topic-label))) + +(transient-define-suffix forge-topics-filter-labels () + "Read labels and limit topic list to topics with one of these labels." + :class 'forge--topics-filter-command + :slot 'labels + :formatter (lambda (labels) (and labels (forge--format-labels labels " ")))) + +(transient-define-suffix forge-topics-filter-marks () + "Read marks and limit topic list to topics with one of these marks." + :class 'forge--topics-filter-command + :slot 'marks + :formatter (lambda (marks) (and marks (forge--format-marks marks " ")))) + +(transient-define-suffix forge-topics-filter-saved () + "Toggle whether to limit topic list to saved topics." + :class 'forge--topics-filter-command + :slot 'saved + :reader #'always + :description + (lambda () (forge--format-boolean 'saved "saved" forge--buffer-topics-spec))) + +(transient-define-suffix forge-topics-filter-author () + "Read an author and limit topic list to topics created by that author." + :class 'forge--topics-filter-command + :slot 'author + :reader (lambda () (forge--read-filter-by-user "Author"))) + +(transient-define-suffix forge-topics-filter-assignee () + "Read an assignee and limit topic list to topics assignee to that person." + :class 'forge--topics-filter-command + :slot 'assignee + :reader (lambda () (forge--read-filter-by-user "Assignee"))) + +(transient-define-suffix forge-topics-filter-reviewer () + "Read a reviewer and limit topic list to reviews requested from that person." + :class 'forge--topics-filter-command + :slot 'reviewer + :reader (lambda () (forge--read-filter-by-user "Reviewer"))) + +(defun forge--read-filter-by-user (prompt) + (let* ((repo (forge-get-repository :tracked)) + (choices (mapcar #'cadr (oref repo assignees)))) + (magit-completing-read prompt choices))) + +;;;; Display + +(transient-define-suffix forge-topics-set-order (order) + "Select order used to display topics in topic list." + :description + (lambda () + (format "order by %s" + (propertize (format "%s" (oref forge--buffer-topics-spec order)) + 'face 'bold))) + (interactive + (list (magit-read-char-case "Order by: " t + (?n "[n]ewest" 'newest) + (?o "[o]ldest" 'oldest) + (?u "[r]ecently updated" 'recently-updated) + (?U "[a]nciently updated" 'anciently-updated)))) + (oset forge--buffer-topics-spec order order) + (forge-refresh-buffer)) + +(transient-define-suffix forge-topics-set-limit (limit) + "Read maximal number of topics to be displayed in topic list." + :description + (lambda () + (if-let ((limit (oref forge--buffer-topics-spec limit))) + (format "limit to %s" (propertize (format "%s" limit) 'face 'bold)) + "no limit")) + (interactive (list (read-number "Limit number (0 for no limit): "))) + (oset forge--buffer-topics-spec limit (if (zerop limit) nil limit)) + (forge-refresh-buffer)) + +(transient-define-suffix forge-topics-group () + "Group topics by repository." + :description "group by repo" + :if (lambda () (oref forge--buffer-topics-spec global)) + :inapt-if (lambda () (oref forge--buffer-topics-spec grouped)) + :inapt-face 'forge-suffix-active + (interactive) + (oset forge--buffer-topics-spec grouped t) + (forge-refresh-buffer)) + +(transient-define-suffix forge-topics-ungroup () + "Show a flat topic list." + :description "single list" + :if (lambda () (oref forge--buffer-topics-spec global)) + :inapt-if-not (lambda () (oref forge--buffer-topics-spec grouped)) + :inapt-face 'forge-suffix-active + (interactive) + (oset forge--buffer-topics-spec grouped nil) + (forge-refresh-buffer)) + +;;; _ +(provide 'forge-topics) +;;; forge-topics.el ends here diff --git a/elpa/forge-20241218.2036/forge.el b/elpa/forge-20241218.2036/forge.el new file mode 100644 index 00000000..81bcf9f3 --- /dev/null +++ b/elpa/forge-20241218.2036/forge.el @@ -0,0 +1,176 @@ +;;; 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 + +;; Package-Version: 20241218.2036 +;; Package-Revision: 3b80ace32c23 +;; Package-Requires: ( +;; (emacs "29.1") +;; (compat "30.0.0.0") +;; (closql "2.1.0") +;; (dash "2.19.1") +;; (emacsql "4.1.0") +;; (ghub "4.2.0") +;; (let-alist "1.0.6") +;; (magit "4.1.3") +;; (markdown-mode "2.6") +;; (seq "2.24") +;; (transient "0.8.0") +;; (yaml "0.5.5")) + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . + +;;; Commentary: + +;; Work with Git forges, such as Github and Gitlab, from the comfort +;; of Magit and the rest of Emacs. + +;; The schema of the database has not been finalized yet. Until that +;; has happened it will occasionally have to be discarded. For now +;; the database does not contain any information that cannot simply +;; be fetched again. + +;;; Code: + +(require 'magit) + +(require 'forge-db) +(require 'forge-core) + +(provide 'forge) + +(require 'forge-repo) +(require 'forge-post) +(require 'forge-topic) +(require 'forge-issue) +(require 'forge-pullreq) +(require 'forge-revnote) +(require 'forge-notify) + +(require 'forge-github) +(require 'forge-gitlab) +(require 'forge-gitea) +(require 'forge-gogs) +(require 'forge-bitbucket) +(require 'forge-semi) + +(require 'forge-commands) +(require 'forge-topics) +(require 'forge-repos) + +;;; Add Sections + +(defvar forge-add-default-sections t + "Whether to add Forge's sections to `magit-status-sections-hook'. + +If you want to disable this, then you must set this to nil before +`forge' is loaded.") + +(when forge-add-default-sections + (magit-add-section-hook 'magit-status-sections-hook #'forge-insert-pullreqs nil t) + (magit-add-section-hook 'magit-status-sections-hook #'forge-insert-issues nil t)) + +;;; Add Bindings + +;;;###autoload +(defvar forge-add-default-bindings t + "Whether to add Forge's bindings to various Magit keymaps. + +If you want to disable this, then you must set this to nil before +`magit' is loaded. If you do it before `forge' but after `magit' +is loaded, then `magit-mode-map' ends up being modified anyway.") + +;;;###autoload +(with-eval-after-load 'magit-mode + (when forge-add-default-bindings + (keymap-set magit-mode-map "'" #'forge-dispatch) + (keymap-set magit-mode-map "N" #'forge-dispatch) + (keymap-set magit-mode-map " " + #'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-pull)) + (transient-append-suffix 'magit-fetch "n" '("N" forge-pull-notifications)) + + (transient-append-suffix 'magit-pull "m" '("n" forge-pull)) + (transient-append-suffix 'magit-pull "n" '("N" forge-pull-notifications)) + + (transient-append-suffix 'magit-branch "w" + '("f" "pull-request" forge-checkout-pullreq)) + (transient-append-suffix 'magit-branch "W" + '("F" "from pull-request" forge-branch-pullreq)) + + (transient-suffix-put 'magit-remote 'magit-update-default-branch :key "b u") + (transient-append-suffix 'magit-remote "b u" + '("b r" "Rename default branch" forge-rename-default-branch)) + + (transient-append-suffix 'magit-worktree "c" + '("n" "pull-request worktree" forge-checkout-worktree)) + + (transient-append-suffix 'magit-status-jump "w" + '("Np" "Pull requests" forge-jump-to-pullreqs)) + (transient-append-suffix 'magit-status-jump "Np" + '("Ni" "Issues" forge-jump-to-issues)) + + (transient-append-suffix 'magit-merge "a" + '(7 "M" "Merge using API" forge-merge))) + +;;; Startup Asserts + +(defconst forge--minimal-git "2.7.0") + +(defun forge-startup-asserts () + (let ((version (magit-git-version))) + (when (and version (version< version forge--minimal-git)) + (display-warning 'magit (format "\ +Forge requires Git >= %s, you are using %s. + +If this comes as a surprise to you, because you do actually have +a newer version installed, then that probably means that the +older version happens to appear earlier on the `$PATH'. If you +always start Emacs from a shell, then that can be fixed in the +shell's init file. If you start Emacs by clicking on an icon, +or using some sort of application launcher, then you probably +have to adjust the environment as seen by graphical interface. +For X11 something like ~/.xinitrc should work. + +If you use Tramp to work inside remote Git repositories, then you +have to make sure a suitable Git is used on the remote machines +too.\n" forge--minimal-git version) :error)))) + +(if after-init-time + (forge-startup-asserts) + (add-hook 'after-init-hook #'forge-startup-asserts t)) + +;;; forge.el ends here diff --git a/elpa/forge-20241218.2036/forge.info b/elpa/forge-20241218.2036/forge.info new file mode 100644 index 00000000..69d64924 --- /dev/null +++ b/elpa/forge-20241218.2036/forge.info @@ -0,0 +1,1984 @@ +This is forge.info, produced by makeinfo version 6.8 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, currently Github and Gitlab, +from the comfort of Magit and Emacs. + +This manual is for Forge version 0.4.5. + + Copyright (C) 2018-2024 Jonas Bernoulli + + + You can redistribute this document and/or modify it under the terms + of the GNU General Public License as published by the Free Software + Foundation, either version 3 of the License, or (at your option) + any later version. + + This document is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + General Public License for more details. + +* Menu: + +* Introduction:: +* Initial Setup:: +* Initial Pull:: +* Getting Started:: +* Lists and Menus:: +* Visiting Topics:: +* Creating Topics and Posts:: +* Editing Topics:: +* Pulling:: +* Branching:: +* Miscellaneous Commands:: +* Miscellaneous Options:: +* How Forge Detection Works:: +* Supported Forges and Hosts:: +* FAQ:: +* Keystroke Index:: +* Function and Command Index:: +* Variable Index:: + +— The Detailed Node Listing — + +Initial Setup + +* Setup for Github.com: Setup for Githubcom. +* Setup for Another Github Instance:: +* Setup for Gitlab.com: Setup for Gitlabcom. +* Setup for Another Gitlab Instance:: +* Setup a Partially Supported Host:: + +Supported Forges and Hosts + +* Supported Forges:: +* Partially Supported Forges:: +* Supported Semi-Forges:: + +FAQ + +* ‘error in process filter HTTP Error 502, "Bad gateway"’: error in process filter HTTP Error 502 "Bad gateway". + + + +File: forge.info, Node: Introduction, Next: Initial Setup, Prev: Top, Up: Top + +1 Introduction +************** + +Forge allows you to work with Git forges, currently Github and Gitlab, +from the comfort of Magit and Emacs. + + Forge fetches issues, pull-requests and other data using the forge’s +API and stores the retrieved information in a local database. +Additionally it fetches pull-request references using Git. + + +File: forge.info, Node: Initial Setup, Next: Initial Pull, Prev: Introduction, Up: Top + +2 Initial Setup +*************** + +Please first do the common setup below and then carefully follow the +instructions for your forge instance. Once you have completed the +setup, you can start tracking repositories (see *note Initial Pull::). + + If you run into difficulties during setup or the initial pull, then +please also see *note How Forge Detection Works:: and *note +(ghub)Getting Started::. + +* Menu: + +* Setup for Github.com: Setup for Githubcom. +* Setup for Another Github Instance:: +* Setup for Gitlab.com: Setup for Gitlabcom. +* Setup for Another Gitlab Instance:: +* Setup a Partially Supported Host:: + +Common Setup +============ + +Loading Magit doesn’t cause Forge to be loaded automatically. Adding +something like this to your init file takes care of that: + + (with-eval-after-load 'magit + (require 'forge)) + +Or if you use ‘use-package’: + + (use-package forge + :after magit) + + By default Forge adds some bindings to Magit keymaps and menus, and +some sections to Magit buffers. If you would like to prevent that, you +have to set ‘forge-add-default-bindings’ and/or +‘forge-add-default-sections’ to ‘nil’, before ‘magit’ (not just ‘forge’) +is loaded. + + +File: forge.info, Node: Setup for Githubcom, Next: Setup for Another Github Instance, Up: Initial Setup + +2.1 Setup for Github.com +======================== + +Set your Username +----------------- + +First inform Forge about your username: + + git config --global github.user USERNAME + + If you need to identify as another user in a particular repository, +then you have to set that variable locally: + + cd /path/to/repo + git config --local github.user USERNAME + +Create and Store an Access Token +-------------------------------- + +Visit in a browser to generate a +new "classic" token using the ‘repo’, ‘user’ and ‘read:org’ scopes. Do +not close the browser window just yet, because the token will only be +shown once. + + The built-in Auth-Source (*note (auth)Top::) package is used to store +the token generated in the previous step. The ‘auth-sources’ variable +controls how and where Auth-Source keeps its secrets. The default value +is a list of three files: ‘("~/.authinfo" "~/.authinfo.gpg" +"~/.netrc")’, but that can lead to confusing behavior, so you should +make sure that only one of these files exists, and then you should also +adjust the value of the variable to only ever use that file, for +example: + + (setq auth-sources '("~/.authinfo")) + + In ‘~/.authinfo’ secrets are stored in plain text. If you don’t want +that, then you should use the encrypted ‘~/.authinfo.gpg’ instead: + + (setq auth-sources '("~/.authinfo.gpg")) + + Make sure you put one of these forms in your init file *and* to +evaluate it in the current Emacs instance as well, by placing the cursor +after the final closing parenthesis and typing ‘C-x C-e’ +(‘eval-last-sexp’). + + Next add a line like the following to the chosen file: + + machine api.github.com login USERNAME^forge password TOKEN + + • The value of ‘machine’ must be ‘api.github.com’. Variations of + this won’t work. + + • USERNAME must be the same as the value used for the ‘github.user’ + Git variable above. You *must* append ‘^forge’ to that, without + any space in between. + + • TOKEN is the token you generated earlier. + + Finish by typing ‘M-x auth-source-forget-all-cached RET’. If you +don’t do this, then Auth-Source may fail to look up the token. + + +File: forge.info, Node: Setup for Another Github Instance, Next: Setup for Gitlabcom, Prev: Setup for Githubcom, Up: Initial Setup + +2.2 Setup for Another Github Instance +===================================== + +Before you setup a Github instance that is not , +please set that up first. The setup for is easier +and if that works, but the setup for the other Github instance fails, +then we can tentatively narrow the issue down to the parts that differ +between and other instances. + +Tell Forge about the Instance +----------------------------- + +While Forge knows about , it does not know about +your other Github instances. Forge instances are configured using the +option ‘forge-alist’ (also see its docstring). The entry for + in that variable looks like this: + + ("github.com" ; GITHOST + "api.github.com" ; APIHOST + "github.com" ; WEBHOST and INSTANCE-ID + forge-github-repository) ; CLASS + + You have to add an entry for your instance. For example, assuming +you company uses , this might be correct: + + (push '("example.com" ; GITHOST + "api.example.com" ; APIHOST + "example.com" ; WEBHOST and INSTANCE-ID + forge-github-repository) ; CLASS + forge-alist) + + Your company may use hostnames that follow a different format. You +should be able to easily determine and verify GITHOST and WEBHOST, but +determining APIHOST is more difficult; you might have to ask a coworker. +APIHOST could be something like ‘api.example.com’, but it could also be +something like ‘example.com/api’. + + If the REST API’s end point is ‘/v3’ and the GraphQL API’s end point +is ‘/graphql’, then use something like ‘example.com/v3’ as APIHOST. +This is a historic accident. See +. + + We will use INSTANCE-ID (aka WEBHOST) and APIHOST below. + +Set your Username +----------------- + +Inform Forge about your username for the Github instance in question: + + git config --global github.INSTANCE-ID.user USERNAME + + So if INSTANCE-ID is ‘example.com’ and USERNAME is ‘tarsius’ then +use: + + git config --global github.example.com.user tarsius + +Create and Store an Access Token +-------------------------------- + +Visit your forge in a browser. Follow a link to "Settings", from there +to "Developer settings", from there to "Personal access tokens", and +finally to "Tokens (classic)". On that page generate a new token using +the ‘repo’, ‘user’ and ‘read:org’ scopes. Do not close the browser +window just yet, because the token will only be shown once. + + The built-in Auth-Source (*note (auth)Top::) package is used to store +the token generated in the previous step. The ‘auth-sources’ variable +controls how and where Auth-Source keeps its secrets. The default value +is a list of three files: ‘("~/.authinfo" "~/.authinfo.gpg" +"~/.netrc")’, but that can lead to confusing behavior, so you should +make sure that only one of these files exists, and then you should also +adjust the value of the variable to only ever use that file, for +example: + + (setq auth-sources '("~/.authinfo")) + + In ‘~/.authinfo’ secrets are stored in plain text. If you don’t want +that, then you should use the encrypted ‘~/.authinfo.gpg’ instead: + + (setq auth-sources '("~/.authinfo.gpg")) + + Make sure you put one of these forms in your init file *and* to +evaluate it in the current Emacs instance as well, by placing the cursor +after the final closing parenthesis and typing ‘C-x C-e’ +(‘eval-last-sexp’). + + Next add a line like the following to the chosen file: + + machine APIHOST login USERNAME^forge password TOKEN + + • APIHOST must be the same as the second element of the entry we + added to ‘forge-alist’. In the above example that would be + ‘api.example.com’. Do *not* instead use GITHOST or INSTANCE-ID + (aka WEBHOST). + + • USERNAME must be the same username you used above as the value of + the Git variable. You *must* append ‘^forge’ to that, without any + space in between. + + • TOKEN is the token you generated earlier. + + Finish by typing ‘M-x auth-source-forget-all-cached RET’. If you +don’t do this, then Auth-Source may fail to look up the token. + + +File: forge.info, Node: Setup for Gitlabcom, Next: Setup for Another Gitlab Instance, Prev: Setup for Another Github Instance, Up: Initial Setup + +2.3 Setup for Gitlab.com +======================== + +Set your Username +----------------- + +First inform Forge about your username: + + git config --global gitlab.user USERNAME + + If you need to identify as another user in a particular repository, +then you have to set that variable locally: + + cd /path/to/repo + git config --local gitlab.user USERNAME + +Create and Store an Access Token +-------------------------------- + +Visit in a +browser to generate a new token using the ‘api’, ‘read_api’ and +‘read_user’ scopes. Do not close the browser window just yet, because +the token will only be shown once. + + The built-in Auth-Source (*note (auth)Top::) package is used to store +the token generated in the previous step. The ‘auth-sources’ variable +controls how and where Auth-Source keeps its secrets. The default value +is a list of three files: ‘("~/.authinfo" "~/.authinfo.gpg" +"~/.netrc")’, but that can lead to confusing behavior, so you should +make sure that only one of these files exists, and then you should also +adjust the value of the variable to only ever use that file, for +example: + + (setq auth-sources '("~/.authinfo")) + + In ‘~/.authinfo’ secrets are stored in plain text. If you don’t want +that, then you should use the encrypted ‘~/.authinfo.gpg’ instead: + + (setq auth-sources '("~/.authinfo.gpg")) + + Make sure you put one of these forms in your init file *and* to +evaluate it in the current Emacs instance as well, by placing the cursor +after the final closing parenthesis and typing ‘C-x C-e’ +(‘eval-last-sexp’). + + Next add a line like the following to the chosen file: + + machine gitlab.com/api/v4 login USERNAME^forge password TOKEN + + • The value of ‘machine’ must be ‘gitlab.com/api/v4’. Variations of + this won’t work. + + • USERNAME must be the same as the value used for the ‘gitlab.user’ + Git variable above. You *must* append ‘^forge’ to that, without + any space in between. + + • TOKEN is the token you generated earlier. + + Finish by typing ‘M-x auth-source-forget-all-cached RET’. If you +don’t do this, then Auth-Source may fail to look up the token. + + +File: forge.info, Node: Setup for Another Gitlab Instance, Next: Setup a Partially Supported Host, Prev: Setup for Gitlabcom, Up: Initial Setup + +2.4 Setup for Another Gitlab Instance +===================================== + +Before you setup a Gitlab instance that is not , +please set that up first. The setup for is easier +and if that works, but the setup for the other Gitlab instance fails, +then we can tentatively narrow the issue down to the parts that differ +between and other instances. + +Tell Forge about the Instance +----------------------------- + +While Forge knows about (and a few other well-known +instances, see its value) it has to be taught about other Gitlab +instances. Forge instances are configured using the option +‘forge-alist’ (also see its docstring). The entry for + in that variable looks like this: + + ("gitlab.com" ; GITHOST + "gitlab.com/api/v4" ; APIHOST + "gitlab.com" ; WEBHOST and INSTANCE-ID + forge-gitlab-repository) ; CLASS + + For historic reasons, APIHOST actually has to be a host followed by a +path. + + You have to add an entry for your instance. For example, assuming +you company/organisation uses , this might be +correct: + + (push '("example.com" ; GITHOST + "example.com/api/v4" ; APIHOST + "example.com" ; WEBHOST and INSTANCE-ID + forge-gitlab-repository) ; CLASS + forge-alist) + + Your company may use hostnames that follow a different format. You +should be able to easily determine and verify GITHOST and WEBHOST, but +determining APIHOST is more difficult; you might have to ask a +colleague. + + We will use INSTANCE-ID (aka WEBHOST) and APIHOST below. + +Set your Username +----------------- + +Inform Forge about your username for the Gitlab instance in question: + + git config --global gitlab.INSTANCE-ID.user USERNAME + + So if INSTANCE-ID is ‘example.com’ and USERNAME is ‘tarsius’ then +use: + + git config --global gitlab.example.com.user tarsius + +Create and Store an Access Token +-------------------------------- + +Visit your forge in a browser. Follow a link to "Preferences" and from +there to "Access Tokens". On that page generate a new "Personal access +token" using the ‘api’, ‘read_api’ and ‘read_user’ scopes. Do not close +the browser window just yet, because the token will only be shown once. + + The built-in Auth-Source (*note (auth)Top::) package is used to store +the token generated in the previous step. The ‘auth-sources’ variable +controls how and where Auth-Source keeps its secrets. The default value +is a list of three files: ‘("~/.authinfo" "~/.authinfo.gpg" +"~/.netrc")’, but that can lead to confusing behavior, so you should +make sure that only one of these files exists, and then you should also +adjust the value of the variable to only ever use that file, for +example: + + (setq auth-sources '("~/.authinfo")) + + In ‘~/.authinfo’ secrets are stored in plain text. If you don’t want +that, then you should use the encrypted ‘~/.authinfo.gpg’ instead: + + (setq auth-sources '("~/.authinfo.gpg")) + + Make sure you put one of these forms in your init file *and* to +evaluate it in the current Emacs instance as well, by placing the cursor +after the final closing parenthesis and typing ‘C-x C-e’ +(‘eval-last-sexp’). + + Next add a line like the following to the chosen file: + + machine APIHOST login USERNAME^forge password TOKEN + + • APIHOST must be the same as the second element of the entry we + added to ‘forge-alist’. In the above example that would be + ‘example.com/api/v4’. Do *not* instead use GITHOST or INSTANCE-ID + (aka WEBHOST). + + • USERNAME must be the same username you used above as the value of + the Git variable. You *must* append ‘^forge’ to that, without any + space in between. + + • TOKEN is the token you generated earlier. + + Finish by typing ‘M-x auth-source-forget-all-cached RET’. If you +don’t do this, then Auth-Source may fail to look up the token. + + +File: forge.info, Node: Setup a Partially Supported Host, Prev: Setup for Another Gitlab Instance, Up: Initial Setup + +2.5 Setup a Partially Supported Host +==================================== + +Forge currently only supports the Github and Gitlab APIs. + + It does however partially support a few additional forge types (see +*note Partially Supported Forges::) and other lighter weight software +used to host Git repositories, which also provide a web interfaces (see +*note Supported Semi-Forges::). Forge doesn’t use the APIs of such +forges, but registering the host and adding repositories to the local +database at least enables the use of commands such as ‘forge-browse’. + +Tell Forge about the Instance +----------------------------- + +A few hosts, which use partially supported forge types, are available +out-of-the-box, because they have an entry in the default value of +option ‘forge-alist’ (also see its docstring). For example, the entry +for in that variable looks like this: + + ("codeberg.org" ; GITHOST + "codeberg.org/api/v1" ; APIHOST + "codeberg.org" ; WEBHOST and INSTANCE-ID + forge-gitea-repository) ; CLASS + + To be able to add repositories from a, so far, unknown forge instance +to your local database, you have to add an entry for that instance to +‘forge-alist’. For example, assuming you use another Gitea instance, +hosted at , this might be correct: + + (push '("example.com" ; GITHOST + "example.com/api/v1" ; APIHOST + "example.com" ; WEBHOST and INSTANCE-ID + forge-gitea-repository) ; CLASS + forge-alist) + + Look at ‘forge-alist’ entries of other hosts using the same forge +type as the instance you are configuring, to see what format *might* be +appropriate. You should be able to easily determine and verify GITHOST +and WEBHOST, but determining APIHOST is more difficult; you might have +to ask a colleague. APIHOST could be something like +‘example.com/api/vi’, but it could also be something like +‘api.example.com’. + +Add Support for Additional Forge Types +-------------------------------------- + +For each fully or partially supported forge type, Forge defines at least +a class. The following example is taken from ‘forge-semi.el’: + + (defclass forge-cgit-repository (forge-noapi-repository) + ((commit-url-format :initform "https://%h/%p.git/commit/?id=%r") + (branch-url-format :initform "https://%h/%p.git/log/?h=%r") + (remote-url-format :initform "https://%h/%p.git/about")) + "Cgit from https://git.zx2c4.com/cgit/about. + Different hosts use different url schemata, so we need multiple + classes. See their definitions in \"forge-semi.el\".") + + Once you add a host using that class to ‘forge-alist’ and then a +repository from that host to the local database, you will be able to use +commands such as ‘forge-browse-branch’ (but not much more). + + If you want to add a repository from another host, which happens to +use another software or another URL schemata, then you might have to +define an additional class first. See ‘forge-semi.el’ for simple +examples and grep for ‘defclass forge-.*-repository’ for more complex +ones. + + +File: forge.info, Node: Initial Pull, Next: Getting Started, Prev: Initial Setup, Up: Top + +3 Initial Pull +************** + +To start using Forge in a certain repository, visit the Magit status +buffer for that repository and type ‘N / a’ (‘forge-add-repository’). +You are given a choice to pull all topics, all topics that were updated +after a certain date, or only individual topics. + + Beside adding the repository to the database, this also adds a new +value to the Git variable ‘remote..fetch’, which causes all +pull-request refs (‘+refs/pull/*/head:refs/pullreqs/*’ for Github) to be +fetched by Git. + + Note that it is possible to use the same command to add any +repository from a supported forge to the database, without cloning the +Git repository first. + + The initial fetch can take a while but most of the work is done +asynchronously. Storing the information in the database is done +synchronously though, so there can be a noticeable hang at the end. +Subsequent fetches are much faster. + + Fetching issues from Github is much faster than fetching from other +forges, because making a handful of GraphQL requests, is much faster +than making hundreds of REST requests. + + +File: forge.info, Node: Getting Started, Next: Lists and Menus, Prev: Initial Pull, Up: Top + +4 Getting Started +***************** + +Much like Git stores information in a local repository and does not +require a constant internet connection, Forge retrieves additional +information using a forge’s API and stores that in a local database. + + Forge’s equivalent of ‘git clone’ is ‘forge-add-repository’, which +has to be run, before most of Forges features become available in the +local clone of a Git repository. + +‘N / a’ (‘forge-add-repository’) + This command guides the user through the process of adding a + repository to the local database. + + Note that it is possible to add a repository to the local database, + without pulling all the data, which is useful if you just want to + create a single issue or pull-request in a repository, but are not + interested in existing topics, e.g., because you do not regularly + contribute to that repository. + + Also note that you can add a repository to the local database, even + if no local Git clone exists. + + Like with Git, you have to explicitly pull remote changes, at your +leisure, using ‘forge-pull’. + +‘f n’ (‘forge-pull’) +‘N f f’ + This command uses a forge’s API to fetch topics and other + information about the current repository, and stores the fetched + information in the database. + + If the current repository isn’t being tracked in the local database + yet, then this command pivots to behave like + ‘forge-add-repository’. + + Forge adds two additional sections to Magit’s status buffer, which +list open and/or pending issues and pull-requests. Typing ‘RET’, while +the cursor is on a topic section, shows more information about that +topic in a separate buffer. Typing ‘RET’ on a topic list section, shows +that list in a separate buffer, where you can apply different filters. + + The other main entry point to the functionality provided by Forge is +the ‘forge-dispatch’ menu. + +‘N’ (‘forge-dispatch’) + This prefix command is available in all Magit buffers and provides + access to most of the available Forge commands. See the following + sections for information about the available commands. + + +File: forge.info, Node: Lists and Menus, Next: Visiting Topics, Prev: Getting Started, Up: Top + +5 Lists and Menus +***************** + +Topics are listed in two sections in Magit’s status buffer, but can also +be listed in dedicated buffers. Likewise individual topics can be +visited in separate buffers. In both cases this can be done by placing +the cursor on the respective section in the status buffer and typing +‘RET’, or by invoking the appropriate command from Forge’s main menu, on +‘N’ (‘forge-dispatch’). + + List commands and corresponding menu commands exist for topics, +notifications and repositories, but there isn’t always an exclusive +mapping from menu to buffer. The main menu (‘forge-dispatch’), the +configuration menu (‘forge-configure’), the menu which controls the +current topic or the topic at point (‘forge-topic-menu’), and the menu +which controls the topics listed in the current buffer +(‘forge-topics-menu’), are useful in more than one major mode. + + All of these menus feature bindings to directly switch to the other +appropriate menus. So it is enough to remember that ‘N’ always brings +up the dispatch menu; you can always navigate to another menu from +there. + + ‘C-c C-c’ brings up the most appropriate menu for the current buffer. +In Magit’s status buffer the most appropriate menu is Magit’s own +dispatch menu (‘magit-dispatch’), so here the quickest way to invoke +Forge’s dispatch menu is ‘N’. Even in Magit’s status buffer, when the +cursor is an individual topic or on a topic list section, ‘C-c C-c’ +opens the respective menu (‘forge-topics-menu’ or ‘forge-topic-menu’). + + The following sections describe most of the available menu and list +commands. For ‘forge-topic-menu’, see *note Editing Topics::. + +Dispatch and configuration menus +================================ + +‘N’ (‘forge-dispatch’) + This prefix menu command is available in all Magit buffers and + provides access to most of the available Forge commands. See the + following sections for information about the available commands. + +‘N m c’ (‘forge-configure’) + This command displays a menu used to configure the current + repository and some global settings as well. + +Topic menu and list commands +============================ + +‘N m f’ (‘forge-topics-menu’) +‘C-c C-c [in topics list buffer/section]’ + This command displays a menu used to control the list of topics + displayed in the current buffer. + + Note that this command can not only be used in buffers dedicated to + listing topics, but also in Magit’s status buffer. + +‘N l t’ (‘forge-list-topics’) + This command lists the current repository’s issues in a separate + buffer. If the list buffer already exists, this command only + ensures that all types of topics are listed. If any other filters + are in effect, they are left intact. TODO fix preserving type + +‘ [on "Issues" status section]’ (‘forge-list-issues’) + This command lists the current repository’s issues in a separate + buffer. If the list buffer already exists, this command limits the + list to issues. If any other filters are in effect, they are left + intact. + +‘ [on "Pull requests" status section]’ (‘forge-list-pullreqs’) + This command lists the current repository’s pull-requests in a + separate buffer. If the list buffer already exists, this command + limits the list to pull-requests. If any other filters are in + effect, they are left intact. + +‘N l g’ (‘forge-list-global-topics’) + This command lists topics across all tracked repository. If the + list buffer already exists, filters except for the type filter are + left in effect. + + -- Command: forge-list-global-issues + This command lists issues across all tracked repository. If the + list buffer already exists, filters except for the type filter are + left in effect. + + -- Command: forge-list-global-pullreqs + This command lists pull-requests across all tracked repository. If + the list buffer already exists, filters except for the type filter + are in effect. + +Notification menu and list commands +=================================== + +‘N m n’ (‘forge-notifications-menu’) +‘C-c C-c’ + This command displays a menu used to control the list of + notifications displayed in the current buffer. + +‘N l n’ (‘forge-list-notifications’) + This command lists all notifications for all forges in a separate + buffer. + +Repository menu and list commands +================================= + +‘N m r’ (‘forge-repositories-menu’) +‘C-c C-c’ + This command displays a menu used to control the list of + repositories displayed in the current buffer. + +‘N l r’ (‘forge-list-repositories’) + This command lists all known repositories in a separate buffer. + Here "known" means that an entry exists in the local database. + +‘ [on repository]’ (‘forge-visit-this-repository’) + This commands visits the repository at point in a separate buffer. + +‘o [in forge-repositories-menu]’ (‘forge-list-owned-repositories’) + This command lists all known repositories that belong to the user + in a separate buffer. Here "known" means that an entry exists in + the local database. Only Github is supported for now. + + The below options controls which repositories are considered to be +owned by the user. They are additionally used by ‘forge-fork’. + + -- User Option: forge-owned-accounts + This is an alist of accounts that are owned by you. This should + include your username as well as any organization that you own. + + Each element has the form ‘(ACCOUNT . PLIST)’. The following + properties are currently being used: + + • ‘remote-name’ The default name suggested by ‘forge-fork’ for a + fork created within this account. If unspecified, then the + name of the account is used. + + Example: ‘(("tarsius") ("emacsmirror" remote-name "mirror"))’. + + -- User Option: forge-owned-ignored + This is a list of repository names that are considered to not be + owned by you, even though they would have been considered to be + owned by you based on ‘forge-owned-accounts’. + +Exiting menus and lists +======================= + +To exit a menu, type ‘C-g’. If the menu was invoked from another menu +and that menu is useful in the current buffer, then that menu becomes +active again. If that happens and you actually want to quit all menus, +then just type ‘C-g’ again. You can also directly exit all menus by +using ‘C-q’, instead of ‘C-g’. + + Type ‘q’ to quit not only the menu, but also the list or topic detail +buffer. That binding is also available when no menu is active, in which +case it will simply quit the buffer. When invoked from a menu, then +this binding may return to another list buffer, in which case some menu +may also remain active. + +Default topic filters +===================== + + -- User Option: forge-status-buffer-default-topic-filters + This option specifies the filters initially used to limit topics + listed in topic list buffers. + + -- User Option: forge-status-buffer-default-topic-filters + This option specifies the filters initially used to limit topics + listed in Magit status buffers. + + Also see *note Topic sections in Magit status buffers::. + +Topic sections in Magit status buffers +====================================== + +Forge arranges for certain issues and pull-requests to be list in Magit +status buffers, by adding the following functions to +‘magit-status-sections-hook’. + + Which topics are listed initially is customizable using option +‘forge-status-buffer-default-topic-filters’ and can be changed +temporarily for the current buffer, using ‘N m f’ (‘forge-topics-menu’). + + -- Function: forge-insert-issues + This function inserts a list of issues, by default a list of + "active" issues. + + -- Function: forge-insert-pullreqs + This function inserts a list of pull-requests, by default a list of + "active" pull-requests. + + Forge used to provide additional functions to insert hard-coded topic +subsets, but they were removed in favor of the more flexible approach +described above. If you miss the removed sections, you can use the new +‘forge-insert-topics’ helper function to define your own section +inserter functions. See its docstring for more information. + + If you don’t want any topic list sections to be displayed in Magit +status buffers, set ‘forge-add-default-sections’ to ‘nil’ before ‘magit’ +is loaded. + + +File: forge.info, Node: Visiting Topics, Next: Creating Topics and Posts, Prev: Lists and Menus, Up: Top + +6 Visiting Topics +***************** + +The commands, accessible from ‘forge-topic-menu’ (on ‘C-return’), act on +the topic at point; so this menu is useful in buffers dedicated to +listing topics and notifications (which correspond to topics), but also +in the status buffer (which also lists topics). In buffers dedicated to +showing details about a single topic, these commands act on that topic; +so this menu can be used there too. + + To switch to this menu from another menu use ‘m s’. If the cursor is +on a topic or the current buffer visits a topic. + + To display details about a topic in a separate buffer and at the same +time display the topic menu, invoke ‘forge-topic-menu’ with a prefix +argument, i.e., ‘C-u RET’. + +‘ [on topic]’ (‘forge-visit-this-topic’) + This commands visits the topic at point in a separate buffer. When + invoked with a prefix argument then it not only visits the topic in + a separate buffer, it at the same time displays + +‘N v t’ (‘forge-visit-topic’) +‘N v i’ (‘forge-visit-issue’) +‘N v p’ (‘forge-visit-pullreq’) + These commands read a topic, issue or pull-request and visit it in + a separate buffer. + +‘C-c C-o’ (‘forge-browse’) +‘o [on topic in topic list]’ (‘forge-browse-this-topic’) +‘o [on repository in repository list]’ (‘forge-browse-this-repository’) + These commands visit the topic, issue(s), pull-request(s), post, + branch, commit, remote or repository at point in a browser. + + -- Command: forge-browse-commit + -- Command: forge-browse-branch + -- Command: forge-browse-repository +‘N b t’ (‘forge-browse-topic’) +‘N b i’ (‘forge-browse-issue’) +‘N b p’ (‘forge-browse-pullreq’) +‘N b r’ (‘forge-browse-remote’) +‘N b I’ (‘forge-browse-issues’) +‘N b P’ (‘forge-browse-pullreqs’) + These commands read a topic, issue(s), pull-request(s), branch, + commit, remote or repository, and open it in a browser. + + +File: forge.info, Node: Creating Topics and Posts, Next: Editing Topics, Prev: Visiting Topics, Up: Top + +7 Creating Topics and Posts +*************************** + +We call both issues and pull-requests "topics". The contributions to +the conversation are called "posts". The initial topic description is +also called a post. + + Creating a new topic or post and editing an existing post work +similarly to now creating a new commit or editing the message of an +existing commit works in Magit. In both cases the message has to be +written in a separate buffer and then the process has to be finished or +canceled using a separate command. The following commands drop you into +such a buffer. + +‘N c p’ (‘forge-create-pullreq’) +‘C-c C-n [on "Pull requests" section]’ + This command creates a new pull-request for the current repository. + +‘N c i’ (‘forge-create-issue’) +‘C-c C-n [on "Issues" section]’ + This command creates a new issue for the current repository. + +‘C-c C-n’ (‘forge-create-post’) +‘C-c C-r’ + This command creates a new post on an existing topic. It is only + available in buffers that visit an existing topic. + + If the region is active and marks part of an existing post, then + that part of the post is quoted. When a prefix argument is used, + then the complete post, which point is currently on, is quoted. + + The following commands are available in buffers used to edit posts: + +‘C-c C-c’ (‘forge-post-submit’) + This command submits the post that is being edited in the current + buffer. + +‘C-c C-k’ (‘forge-post-cancel’) + This command cancels the post that is being edited in the current + buffer. + +‘C-c C-e’ (‘forge-post-dispatch’) + This prefix command features the above two commands as suffixes, + and when creating a pull-request also the following command. More + suffix commands will likely be added in the future. + +‘C-c C-e d’ (‘forge-post-toggle-draft’) + This command toggles whether the pull-request being created is a + draft. + + +File: forge.info, Node: Editing Topics, Next: Pulling, Prev: Creating Topics and Posts, Up: Top + +8 Editing Topics +**************** + +Many details about a topic can be changed from the buffer that visits +that topic, but also from topic lists, if the cursor is placed on the +topic to be edited. However, to edit the posts on a topic, the topic +has to be visited in its own buffer. + +‘C-c C-e [on a post section]’ (‘forge-edit-post’) + This command visits an existing post in a separate buffer, it can + only be invoked from a topic buffer, when the cursor is on the post + to be edited. + + Editing an existing post is similar to creating a new post, as + described in the previous section. + +‘C-c C-k [on a post section]’ (‘forge-delete-comment’) + This command deletes the post the cursor is on. The initial + message that was written when the topic was created, cannot be + deleted, only replies to that. + +‘N m s’ (‘forge-topic-menu’) +‘C- [on a topic section]’ + This command displays a menu used to edit details about the topic + the cursor is on or that is being visited in the current buffer. + E.g., it can be used to change the status of the topic or to apply + labels to it. Additionally it features a few commands that act on + that topic. + + Details about a topic, such as its status and labels, can +alternatively be edited by visiting the topic in its own buffer, +navigating to the header that displays the detail and then typing ‘C-c +C-e’. This older approach is still available, but it is usually much +faster to use the menu. + + +File: forge.info, Node: Pulling, Next: Branching, Prev: Editing Topics, Up: Top + +9 Pulling +********* + +The commands that fetch forge data are available the Forge’s main menu +(‘forge-dispatch’ on ‘N’) and from the same menu (‘magit-fetch’ on ‘f’) +that is used to fetch Git data. If ‘magit-pull-or-fetch’ is non-nil, +then they are also available from the ‘magit-pull’ menu (on ‘F’). + + With Git you have to explicitly pull Git data to make it available in +the local repository. Forge works the same; you have to explicitly pull +to pull data using the forge’s API and storing in the local database. +This is less disruptive, more reliable, familiar and easier to +understand than if Forge pulled by itself at random intervals. It might +however mean that you occasionally invoke a command expecting the most +recent data to be available and then have to abort and pull first. The +same can happen with Git, e.g., you might attempt to merge a branch that +you know exists but haven’t actually pulled yet. + +‘f n’ (‘forge-pull’) +‘N f f’ + This command uses a forge’s API to fetch topics and other + information about the current repository and stores the fetched + information in the database. + + If the current repository is still untracked locally, or the + current repository cannot be determined, this command instead + behaves like ‘forge-add-repository’, i.e., it adds the repository + to the database and then performs the initial pull. + +‘f N’ (‘forge-pull-notifications’) +‘N f n’ + This command uses a forge’s API to fetch all notifications from + that forge, including, but not limited to, the notifications for + the current repository. + + Fetching notifications fetches associated topics even for + repositories that you have not yet explicitly added to the local + database. + +‘N f t’ (‘forge-pull-topic’) + This command uses a forge’s API to fetch a single pull-request and + stores it in the database. This is useful if you chose to not + fetch all topics when you added the repository using + ‘forge-add-repository’. + + +File: forge.info, Node: Branching, Next: Miscellaneous Commands, Prev: Pulling, Up: Top + +10 Branching +************ + +Forge provides commands for creating and checking out a new branch or +work tree from a pull-request. These commands are available from the +same transient prefix commands as the suffix commands, used to create +and check out branches and work trees in a more generic fashion +(‘magit-branch’ on ‘b’ and ‘magit-worktree’ on ‘%’). + +‘b F’ (‘forge-branch-pullreq’) + This command creates and configures a new branch from a + pull-request, creating and configuring a new remote if necessary. + + The name of the local branch is the same as the name of the remote + branch that you are being asked to merge, unless the contributor + could not be bothered to properly name the branch before opening + the pull-request. The most likely such case is when you are being + asked to merge something like "fork/master" into "origin/master". + In such cases the local branch will be named "pr-N", where ‘N’ is + the pull-request number. + + These variables are always set by this command: + + • ‘branch..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 the new + worktree directory where it checks out the pull-request. It takes + the pull-request as the only argument and must return a directory. + + When you delete a pull-request branch, which was created using one of +the above three commands, then ‘magit-branch-delete’ usually offers to +also delete the corresponding remote. It does not offer to delete a +remote if (1) the remote is the upstream remote, and/or (2) if other +branches are being fetched from the remote. + + Note that you have to delete the local branch (e.g., "feature") for +this to work. If you delete the tracking branch (e.g., "fork/feature"), +then the remote is never removed. + + +File: forge.info, Node: Miscellaneous Commands, Next: Miscellaneous Options, Prev: Branching, Up: Top + +11 Miscellaneous Commands +************************* + +‘N M’ (‘forge-merge’) +‘m M [if enabled]’ + This command merges the current pull-request using the forge’s API. + If there is no current pull-request or with a prefix argument, then + it reads a pull-request to visit instead. + + The "merge method" to be used is read from the user. + + Use of this command is discouraged. Unless the remote repository + is configured to disallow that, you should instead merge locally + and then push the target branch. Forges detect that you have done + that and respond by automatically marking the pull-request as + merged. + +‘N c f’ (‘forge-fork’) + This command adds an additional remote to the current repository. + The remote can either point at an existing repository or one that + has to be created first by forking it to an account the user has + access to. + + Currently this only supports Github and Gitlab. + +‘N - H’ (‘forge-toggle-topic-legend’) + This command toggle whether to show a legend for faces used in + topic menus and lists. + +‘N - S’ (‘forge-toggle-display-in-status-buffer’) + This command toggles whether any topics are displayed in the + current Magit status buffer. + +‘C-c C-w’ (‘forge-copy-url-at-point-as-kill’) + This command copies the url for the topic, issue(s), + pull-request(s), post, branch, commit, remote or repository to the + kill-ring. + + This determines the url the same way as ‘forge-browse’ does, but + then adds it to the kill-ring, instead of visiting it in a browser. + +‘M b r’ (‘forge-rename-default-branch’) + This command rename the default branch to a new name read from the + user. + + This changes the name on the upstream remotely and locally, and + update the upstream remotes of local branches accordingly. + + -- Command: forge-add-pullreq-refspec + This command configures Git to fetch all pull-requests. + + This is done by adding ‘+refs/pull/*/head:refs/pullreqs/*’ to the + value of ‘remote.REMOTE.fetch’, where REMOTE is the upstream + remote. + + -- Command: forge-add-user-repositories + This command reads a host and a username from the user and adds all + of that user’s repositories on that host to the local database. + + This may take a while. Only Github is supported at the moment. + + -- Command: forge-add-organization-repositories + This command reads a host and an organization from the user and + adds all the organization’s repositories on that host to the local + database. + + This may take a while. Only Github is supported at the moment. + + -- Command: forge-remove-repository + This command reads a repository and removes it from the local + database. + + -- Command: forge-remove-topic-locally + This command reads a topic and removes it from the local database. + The topic is not removed from the forge and, if it is later + modified, then it will be added to the database again. + + Due to how the supported APIs work, it would be too expensive to + automatically remove topics from the local database that were + removed from the forge. The only purpose of this command is to + allow you to manually clean up the local database. + + -- Command: forge-reset-database + This command moves the current database file to the trash and + creates a new empty database. + + This is useful after the database’s table schemata have changed, + which will happen a few times while the Forge functionality is + still under heavy development. + + +File: forge.info, Node: Miscellaneous Options, Next: How Forge Detection Works, Prev: Miscellaneous Commands, Up: Top + +12 Miscellaneous Options +************************ + + -- User Option: forge-database-file + This option specifies the file used to store the forge database. + + -- User Option: forge-topic-repository-slug-width + This option specifies the width of repository slugs (i.e., + "OWNER/NAME"). + + -- User Option: forge-buffer-draft-p + This option controls whether new pull-requests start out as drafts + by default. + + The buffer-local value of this variable is used to keep track of + the draft status of the current pull-request. + + -- User Option: forge-repository-list-columns + This option specifies the list of columns displayed when listing + repositories. + + Each element has the form ‘(HEADER SOURCE WIDTH SORT PROPS)’. + + HEADER is the string displayed in the header. WIDTH is the width + of the column. SOURCE is used to get the value, it has to be the + name of a slot of ‘forge-repository’ or a function that takes such + an object as argument. SORT is a boolean or a function used to + sort by this column. Supported PROPS include ‘:right-align’ and + ‘:pad-right’. + + -- User Option: forge-limit-topic-choices + This option controls whether to initially limit completion + candidates to active topics. + + -- User Option: forge-post-heading-format + This option specifies the format for post headings in topic view. + + The following ‘%’-sequences are supported: + + • ‘%a’ The forge nickname of the author. + • ‘%c’ The absolute creation date. + • ‘%C’ The relative creation date. + + -- User Option: forge-post-fill-region + This option controls whether to call ‘fill-region’ before + displaying forge posts. + + -- User Option: forge-bug-reference-hooks + This option lists the hooks to which ‘forge-bug-reference-setup’ is + added. It has to be customized before ‘forge’ is loaded, or it + won’t take effect. + + +File: forge.info, Node: How Forge Detection Works, Next: Supported Forges and Hosts, Prev: Miscellaneous Options, Up: Top + +Appendix A How Forge Detection Works +************************************ + +Forge uses the Ghub package to communicate with forge APIs. For more +information about Ghub, see *note (ghub)Top::. + + Ghub does *not* associate a given local repository with a repository +on a forge. The Forge package itself takes care of this. In doing so +it ignores the Git variable ‘ghub.host’ and other ‘*.host’ variables +used by Ghub. (But ‘github.user’, and other variables used to specify +the user, are honored). + + Forge associates the local repository with a forge repository, by +first determining which remote is associated with the upstream +repository, and then looking that up in ‘forge-alist’. + + If only one remote exists, then Forge uses that unconditionally. To +reduce the number of support requests, this is even the case if the Git +variable ‘forge.remote’ names another, non-existent, remote. + + If several remotes exist, then a remote may be selected based on its +name. Almost always we want to fetch the data associated with the +upstream repository, so that is what the logic described here tries to +achieve. The convention is to name the upstream remote "origin", and if +that convention were universally followed, then things would be trivial. +However many people name the upstream remote "upstream", which also +makes sense. + + Note, however, that even though a surprising number of people do + just that, it does not make any sense to use the name "origin" to + refer to a fork; not even to your own fork. A fork is a *copy* of + the original, "copy" is an antonym for "original", and the word + "origin" is not only closely related to but is even contained in + the word "original". Naming a fork the "origin" is at best + extremely confusing. + + copy + a thing made to be similar or identical to another. + + original + the earliest form of something, from which copies may be made. + + origin + the point or place where something begins, arises, or is + derived. + + If several remotes exist, then the following remote names are tried +in order and the first remote thus named that exists in the repository +is used. + + 1. The value of the Git variable ‘forge.remote’, if set. If the + variable has a value but no remote by the specified name exists, + then a warning is shown, but otherwise this conflict is ignored. + This behavior is arguably odd, but due to historic and pragmatic + reasons it is the least painful path forward. + + 2. The remote named ‘upstream’, if it exists. + + 3. The remote named ‘origin’, if it exists. + + The remote named "upstream" is preferred over the remote named +"origin" because the existence of the former strongly suggests that the +latter is either not used in this repository (in which case the order +does not matter) or else it is abused as the name of a fork (in which +case "upstream" must be preferred). + + -- Variable: forge.remote + The value of this variable specifies the remote from which Forge + fetches data. It is usually best to leave this unspecified and to + rely on the behavior described above. + + If the remote has to be specified explicitly, then this should be + done locally, for a single repository. + + Only ever set this globally, if you consistently use a certain name + to refer to the upstream repository and it isn’t one of "upstream" + or "origin", and you *never* use that name to refer to a repository + that does *not* refer to the upstream repository. + +‘N r’ (‘forge-forge.remote’) + This command changes the value of the ‘forge.remote’ Git variable + in the current repository. + + If this variable is set, then Forge uses the remote by that name, if +it exists, the same way it may have used ‘origin’ if the variable were +undefined. I.e., it does not fall through to try ‘origin’ if no remote +by your chosen name exists. + + Once the upstream remote has been determined, Forge looks it up in +‘forge-alist’, using the host part of the URL as the key. For example, +the key for ‘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: Supported Forges and Hosts, Next: FAQ, Prev: How Forge Detection Works, Up: Top + +Appendix B Supported Forges and Hosts +************************************* + +Currently Forge supports two forges and three more forges partially. +Additionally it supports four semi-forges. Support for more forges and +semi-forges can and will be added. + + Both forges and semi-forges provide web interfaces for Git +repositories. Forges additionally support pull-requests and issues and +make those and other information available using an API. + + When a forge is only partially supported, then that means that only +the functionality that does not require the API is implemented, or in +other words, that the forge is only supported as a semi-forge. + + A host is a particular instance of a forge. For example the hosts + 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 How Forge Detection Works::). + + For more details about the caveats mentioned below (and some others) +see also *note Getting Started::. + +* Menu: + +* Supported Forges:: +* Partially Supported Forges:: +* Supported Semi-Forges:: + + +File: forge.info, Node: Supported Forges, Next: Partially Supported Forges, Up: Supported Forges and Hosts + +B.1 Supported Forges +==================== + +B.1.1 Github +------------ + +Forge’s support for Github can be considered the "reference +implementation". Support for other forges can lag behind a bit. + +B.1.1.1 Github Caveats +...................... + + • Forge uses the Github GraphQL API when possible but has to fall + back to use the REST API in many cases because the former is still + rather incomplete. + + • The Github GraphQL API has a hard-coded timeout on queries. The + only solution is to reduce the number of entities we query at once, + which can be done by adjusting either the ‘forge.graphqlItemLimit’ + git variable or the field "GQL entity limit" in a status buffer. + + • Forge depends on the ‘updated_at’ field being updated when + appropriate. For Github pull-requests at least, that is not always + done. + +B.1.1.2 Github Hosts +.................... + + • + +B.1.2 Gitlab +------------ + +B.1.2.1 Gitlab Caveats +...................... + + • Forge cannot provide notifications because the Gitlab API does not + expose those. + +B.1.2.2 Gitlab Hosts +.................... + + • + • + • + + +File: forge.info, Node: Partially Supported Forges, Next: Supported Semi-Forges, Prev: Supported Forges, Up: Supported Forges and Hosts + +B.2 Partially Supported Forges +============================== + +B.2.1 Gitea +------------------------------ + +This is the next forge whose API will be supported. + +B.2.1.1 Gitea Hosts +................... + + • + +B.2.2 Gogs +---------------------------- + +Once Gitea is supported it should be fairly simple to support Gogs too, +because the former is a fork of the latter and the APIs seem to still be +very similar. + +B.2.2.1 Gogs Hosts +.................. + + • + +B.2.3 Bitbucket +--------------------------------------- + +I don’t plan to support Bitbucket’s API any time soon, and it gets less +likely that I will every do it every time I look at it. + +B.2.3.1 Bitbucket Caveats +......................... + + • The API documentation is poor and initial tests indicated that the + implementation is buggy. + + • Atlassian’s offering contains two very distinct implementations + that are both called "Bitbucket". Forge only supports the + implementation whose only instance is available at + , 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: . + +B.2.3.2 Bitbucket Hosts +....................... + + • + + +File: forge.info, Node: Supported Semi-Forges, Prev: Partially Supported Forges, Up: Supported Forges and Hosts + +B.3 Supported Semi-Forges +========================= + +B.3.1 Gitweb +---------------------------------------------- + +B.3.1.1 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). + +B.3.2 Cgit +--------------------------------------------- + +B.3.2.1 Cgit Caveats +.................... + + • Different sites use different URL schemata and some of the bigger + sites use a fork. For this reason Forge has to provide several + classes to support different variations of Cgit and you have to + look at their definitions to figure out which one is the correct + one for a particular installation. + +B.3.2.2 Cgit Hosts +.................. + + • + • + • + +B.3.3 Stgit +----------------------------------------------------------------- + +B.3.3.1 Stgit Caveats +..................... + + • Stgit cannot show logs for branches beside "master". For that + reason Forge takes users to a page listing the branches when they + request the log for a particular branch (even for "master" whose + log is just one click away from there). + +B.3.3.2 Stgit Hosts +................... + + • + +B.3.4 Srht +------------------------------- + +B.3.4.1 Srht Caveats +.................... + + • Srht cannot show logs for branches beside "master". For that + reason Forge takes users to a page listing the branches when they + request the log for a particular branch (even for "master" whose + log is just one click away from there). + +B.3.4.2 Srht Hosts +.................. + + • + + +File: forge.info, Node: FAQ, Next: Keystroke Index, Prev: Supported Forges and Hosts, Up: Top + +Appendix C FAQ +************** + +This section lists some frequently asked questions. Please see also + for an extended list of common +issues. + +* Menu: + +* ‘error in process filter HTTP Error 502, "Bad gateway"’: error in process filter HTTP Error 502 "Bad gateway". + + +File: forge.info, Node: error in process filter HTTP Error 502 "Bad gateway", Up: FAQ + +C.1 ‘error in process filter: HTTP Error: 502, "Bad gateway"’ +============================================================= + +This is a frequently occurring error. Adding some formatting, the full +error is: + + error in process filter: ghub--signal-error: HTTP Error: 502, + "Bad gateway", "/graphql", + ((data . "null") + (errors ((message . "Something went wrong while executing your query. + This may be the result of a timeout, or it could be a GitHub bug. + Please include `CC2C:4FEA:A1771C1:CBF40CE:5C33F7E5` + when reporting this issue.")))) + + This indicates that something went wrong within Github’s network. +Unfortunately the reason given is rather vague, but I believe this +usually happens when there are topics with one or two magnitudes more +posts than usual, which can cause GraphQL responses to become huge. + + This can be countered in the affected repository by setting the Git +variable ‘forge.graphqlItemLimit’: + + git config --local forge.graphqlItemLimit 20 + + The default is specified using the ‘ghub-graphql-items-per-request’, +which defaults to 50 (down from Github’s default and maximum of 100). + + Fetching less items per request results in more requests, which slows +down the process, which is why the default should not be too small, but +for some repositories a more aggressive limit is needed. + + +File: forge.info, Node: Keystroke Index, Next: Function and Command Index, Prev: FAQ, Up: Top + +Appendix D Keystroke Index +************************** + +[index] +* Menu: + +* b F: Branching. (line 13) +* b f: Branching. (line 102) +* C- [on a topic section]: Editing Topics. (line 26) +* C-c C-c: Lists and Menus. (line 97) +* C-c C-c <1>: Lists and Menus. (line 109) +* C-c C-c <2>: Creating Topics and Posts. + (line 37) +* C-c C-c [in topics list buffer/section]: Lists and Menus. (line 53) +* C-c C-e: Creating Topics and Posts. + (line 45) +* C-c C-e d: Creating Topics and Posts. + (line 50) +* C-c C-e [on a post section]: Editing Topics. (line 12) +* C-c C-k: Creating Topics and Posts. + (line 41) +* C-c C-k [on a post section]: Editing Topics. (line 20) +* C-c C-n: Creating Topics and Posts. + (line 27) +* C-c C-n [on "Issues" section]: Creating Topics and Posts. + (line 23) +* C-c C-n [on "Pull requests" section]: Creating Topics and Posts. + (line 19) +* C-c C-o: Visiting Topics. (line 34) +* C-c C-r: Creating Topics and Posts. + (line 27) +* C-c C-w: Miscellaneous Commands. + (line 37) +* f n: Getting Started. (line 32) +* f n <1>: Pulling. (line 23) +* f N: Pulling. (line 34) +* M b r: Miscellaneous Commands. + (line 45) +* m M [if enabled]: Miscellaneous Commands. + (line 8) +* N: Getting Started. (line 50) +* N <1>: Lists and Menus. (line 40) +* N - H: Miscellaneous Commands. + (line 29) +* N - S: Miscellaneous Commands. + (line 33) +* N / a: Getting Started. (line 15) +* N b i: Visiting Topics. (line 46) +* N b I: Visiting Topics. (line 46) +* N b p: Visiting Topics. (line 46) +* N b P: Visiting Topics. (line 46) +* N b r: Visiting Topics. (line 46) +* N b t: Visiting Topics. (line 46) +* N c f: Miscellaneous Commands. + (line 21) +* N c i: Creating Topics and Posts. + (line 23) +* N c p: Creating Topics and Posts. + (line 19) +* N f f: Getting Started. (line 32) +* N f f <1>: Pulling. (line 23) +* N f n: Pulling. (line 34) +* N f t: Pulling. (line 43) +* N l g: Lists and Menus. (line 78) +* N l n: Lists and Menus. (line 101) +* N l r: Lists and Menus. (line 113) +* N l t: Lists and Menus. (line 60) +* N M: Miscellaneous Commands. + (line 8) +* N m c: Lists and Menus. (line 45) +* N m f: Lists and Menus. (line 53) +* N m n: Lists and Menus. (line 97) +* N m r: Lists and Menus. (line 109) +* N m s: Editing Topics. (line 26) +* N r: How Forge Detection Works. + (line 83) +* N v i: Visiting Topics. (line 28) +* N v p: Visiting Topics. (line 28) +* N v t: Visiting Topics. (line 28) +* o [in forge-repositories-menu]: Lists and Menus. (line 120) +* o [on repository in repository list]: Visiting Topics. (line 34) +* o [on topic in topic list]: Visiting Topics. (line 34) +* RET [on "Issues" status section]: Lists and Menus. (line 66) +* RET [on "Pull requests" status section]: Lists and Menus. (line 72) +* RET [on repository]: Lists and Menus. (line 117) +* RET [on topic]: Visiting Topics. (line 21) +* Z n: Branching. (line 107) + + +File: forge.info, Node: Function and Command Index, Next: Variable Index, Prev: Keystroke Index, Up: Top + +Appendix E Function and Command Index +************************************* + +[index] +* Menu: + +* forge-add-organization-repositories: Miscellaneous Commands. + (line 64) +* forge-add-pullreq-refspec: Miscellaneous Commands. + (line 51) +* forge-add-repository: Getting Started. (line 15) +* forge-add-user-repositories: Miscellaneous Commands. + (line 58) +* forge-branch-pullreq: Branching. (line 13) +* forge-browse: Visiting Topics. (line 34) +* forge-browse-branch: Visiting Topics. (line 38) +* forge-browse-commit: Visiting Topics. (line 37) +* forge-browse-issue: Visiting Topics. (line 46) +* forge-browse-issues: Visiting Topics. (line 46) +* forge-browse-pullreq: Visiting Topics. (line 46) +* forge-browse-pullreqs: Visiting Topics. (line 46) +* forge-browse-remote: Visiting Topics. (line 46) +* forge-browse-repository: Visiting Topics. (line 39) +* forge-browse-this-repository: Visiting Topics. (line 34) +* forge-browse-this-topic: Visiting Topics. (line 34) +* forge-browse-topic: Visiting Topics. (line 46) +* forge-checkout-pullreq: Branching. (line 102) +* forge-checkout-worktree: Branching. (line 107) +* forge-configure: Lists and Menus. (line 45) +* forge-copy-url-at-point-as-kill: Miscellaneous Commands. + (line 37) +* forge-create-issue: Creating Topics and Posts. + (line 23) +* forge-create-post: Creating Topics and Posts. + (line 27) +* forge-create-pullreq: Creating Topics and Posts. + (line 19) +* forge-delete-comment: Editing Topics. (line 20) +* forge-dispatch: Getting Started. (line 50) +* forge-dispatch <1>: Lists and Menus. (line 40) +* forge-edit-post: Editing Topics. (line 12) +* forge-forge.remote: How Forge Detection Works. + (line 83) +* forge-fork: Miscellaneous Commands. + (line 21) +* forge-insert-issues: Lists and Menus. (line 184) +* forge-insert-pullreqs: Lists and Menus. (line 188) +* forge-list-global-issues: Lists and Menus. (line 82) +* forge-list-global-pullreqs: Lists and Menus. (line 87) +* forge-list-global-topics: Lists and Menus. (line 78) +* forge-list-issues: Lists and Menus. (line 66) +* forge-list-notifications: Lists and Menus. (line 101) +* forge-list-owned-repositories: Lists and Menus. (line 120) +* forge-list-pullreqs: Lists and Menus. (line 72) +* forge-list-repositories: Lists and Menus. (line 113) +* forge-list-topics: Lists and Menus. (line 60) +* forge-merge: Miscellaneous Commands. + (line 8) +* forge-notifications-menu: Lists and Menus. (line 97) +* forge-post-cancel: Creating Topics and Posts. + (line 41) +* forge-post-dispatch: Creating Topics and Posts. + (line 45) +* forge-post-submit: Creating Topics and Posts. + (line 37) +* forge-post-toggle-draft: Creating Topics and Posts. + (line 50) +* forge-pull: Getting Started. (line 32) +* forge-pull <1>: Pulling. (line 23) +* forge-pull-notifications: Pulling. (line 34) +* forge-pull-topic: Pulling. (line 43) +* forge-remove-repository: Miscellaneous Commands. + (line 71) +* forge-remove-topic-locally: Miscellaneous Commands. + (line 75) +* forge-rename-default-branch: Miscellaneous Commands. + (line 45) +* forge-repositories-menu: Lists and Menus. (line 109) +* forge-reset-database: Miscellaneous Commands. + (line 85) +* forge-toggle-display-in-status-buffer: Miscellaneous Commands. + (line 33) +* forge-toggle-topic-legend: Miscellaneous Commands. + (line 29) +* forge-topic-menu: Editing Topics. (line 26) +* forge-topics-menu: Lists and Menus. (line 53) +* forge-visit-issue: Visiting Topics. (line 28) +* forge-visit-pullreq: Visiting Topics. (line 28) +* forge-visit-this-repository: Lists and Menus. (line 117) +* forge-visit-this-topic: Visiting Topics. (line 21) +* forge-visit-topic: Visiting Topics. (line 28) + + +File: forge.info, Node: Variable Index, Prev: Function and Command Index, Up: Top + +Appendix F Variable Index +************************* + +[index] +* Menu: + +* forge-alist: How Forge Detection Works. + (line 95) +* forge-buffer-draft-p: Miscellaneous Options. + (line 13) +* forge-bug-reference-hooks: Miscellaneous Options. + (line 50) +* forge-checkout-worktree-read-directory-function: Branching. (line 112) +* forge-database-file: Miscellaneous Options. + (line 6) +* forge-limit-topic-choices: Miscellaneous Options. + (line 33) +* forge-owned-accounts: Lists and Menus. (line 127) +* forge-owned-ignored: Lists and Menus. (line 140) +* forge-post-fill-region: Miscellaneous Options. + (line 46) +* forge-post-heading-format: Miscellaneous Options. + (line 37) +* forge-repository-list-columns: Miscellaneous Options. + (line 20) +* forge-status-buffer-default-topic-filters: Lists and Menus. (line 163) +* forge-status-buffer-default-topic-filters <1>: Lists and Menus. + (line 167) +* forge-topic-repository-slug-width: Miscellaneous Options. + (line 9) +* forge.remote: How Forge Detection Works. + (line 69) + + + +Tag Table: +Node: Top771 +Node: Introduction2507 +Node: Initial Setup2928 +Ref: Common Setup3633 +Node: Setup for Githubcom4227 +Ref: Set your Username4388 +Ref: Create and Store an Access Token4718 +Node: Setup for Another Github Instance6586 +Ref: Tell Forge about the Instance7134 +Ref: Set your Username (1)8680 +Ref: Create and Store an Access Token (1)8988 +Node: Setup for Gitlabcom11089 +Ref: Set your Username (2)11292 +Ref: Create and Store an Access Token (2)11622 +Node: Setup for Another Gitlab Instance13513 +Ref: Tell Forge about the Instance (1)14074 +Ref: Set your Username (3)15415 +Ref: Create and Store an Access Token (3)15723 +Node: Setup a Partially Supported Host17775 +Ref: Tell Forge about the Instance (2)18460 +Ref: Add Support for Additional Forge Types19956 +Node: Initial Pull21127 +Node: Getting Started22334 +Node: Lists and Menus24620 +Ref: Dispatch and configuration menus26444 +Ref: Topic menu and list commands26903 +Ref: Notification menu and list commands28840 +Ref: Repository menu and list commands29217 +Ref: Exiting menus and lists30984 +Ref: Default topic filters31679 +Ref: Topic sections in Magit status buffers32119 +Node: Visiting Topics33350 +Node: Creating Topics and Posts35464 +Node: Editing Topics37546 +Node: Pulling39171 +Node: Branching41333 +Node: Miscellaneous Commands47726 +Node: Miscellaneous Options51450 +Node: How Forge Detection Works53535 +Node: Supported Forges and Hosts59072 +Node: Supported Forges60381 +Ref: Github60537 +Ref: Github Caveats60692 +Ref: Github Hosts61354 +Ref: Gitlab61426 +Ref: Gitlab Caveats61453 +Ref: Gitlab Hosts61594 +Node: Partially Supported Forges61730 +Ref: Gitea https//giteaio61936 +Ref: Gitea Hosts62052 +Ref: Gogs https//gogsio62124 +Ref: Gogs Hosts62343 +Ref: Bitbucket https//bitbucketorg62417 +Ref: Bitbucket Caveats62631 +Ref: Bitbucket Hosts63544 +Node: Supported Semi-Forges63625 +Ref: Gitweb https//git-scmcom/docs/gitweb63796 +Ref: Gitweb Caveats63891 +Ref: Cgit https//gitzx2c4com/cgit/about64147 +Ref: Cgit Caveats64240 +Ref: Cgit Hosts64605 +Ref: Stgit https//codemadnessorg/git/stagit/file/READMEhtml64748 +Ref: Stgit Caveats64881 +Ref: Stgit Hosts65183 +Ref: Srht https//metasrht65259 +Ref: Srht Caveats65324 +Ref: Srht Hosts65623 +Node: FAQ65690 +Node: error in process filter HTTP Error 502 "Bad gateway"66100 +Node: Keystroke Index67581 +Node: Function and Command Index73561 +Node: Variable Index79841 + +End Tag Table + + +Local Variables: +coding: utf-8 +End: