From: Andreas Gerler Date: Thu, 23 Nov 2023 19:13:31 +0000 (+0100) Subject: update forge X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=f25b1bccc6d494964a2b0c2e24b809161c1cb290;p=emacsconfig.git update forge Signed-off-by: Andreas Gerler --- diff --git a/elpa/forge-20230505.926/dir b/elpa/forge-20230505.926/dir deleted file mode 100644 index e9289b26..00000000 --- a/elpa/forge-20230505.926/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-20230505.926/forge-autoloads.el b/elpa/forge-20230505.926/forge-autoloads.el deleted file mode 100644 index fb9bc561..00000000 --- a/elpa/forge-20230505.926/forge-autoloads.el +++ /dev/null @@ -1,443 +0,0 @@ -;;; forge-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "forge" "forge.el" (0 0 0 0)) -;;; Generated autoloads from forge.el - -(defvar forge-add-default-bindings t "\ -Whether to add Forge's bindings to various Magit keymaps. - -If you want to disable this, then you must set this to nil before -`magit' is loaded. If you do it before `forge' but after `magit' -is loaded, then `magit-mode-map' ends up being modified anyway. - -If this is nil, then `forge-toggle-display-in-status-buffer' can -no longer do its job. It might be better to set the global value -of `forge-display-in-status-buffer' to nil instead. That way you -can still display topics on demand in the status buffer.") - -(with-eval-after-load 'git-commit (when forge-add-default-bindings (define-key git-commit-mode-map (kbd "C-c C-v") #'forge-visit-topic))) - -(with-eval-after-load 'magit-mode (when forge-add-default-bindings (define-key magit-mode-map "'" #'forge-dispatch) (define-key magit-mode-map "N" #'forge-dispatch))) - -(register-definition-prefixes "forge" '("forge-")) - -;;;*** - -;;;### (autoloads nil "forge-bitbucket" "forge-bitbucket.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from forge-bitbucket.el - -(register-definition-prefixes "forge-bitbucket" '("forge-bitbucket-repository")) - -;;;*** - -;;;### (autoloads nil "forge-commands" "forge-commands.el" (0 0 0 -;;;;;; 0)) -;;; Generated autoloads from forge-commands.el - (autoload 'forge-dispatch "forge-commands" nil t) - -(autoload 'forge-pull "forge-commands" "\ -Pull topics from the forge repository. - -With a prefix argument and if the repository has not been fetched -before, then read a date from the user and limit pulled topics to -those that have been updated since then. - -If pulling is too slow, then also consider setting the Git variable -`forge.omitExpensive' to `true'. - -\(fn &optional REPO UNTIL)" t nil) - -(autoload 'forge-pull-notifications "forge-commands" "\ -Fetch notifications for all repositories from the current forge." t nil) - -(autoload 'forge-pull-topic "forge-commands" "\ -Pull the API data for the current topic. -If there is no current topic or with a prefix argument read a -TOPIC to pull instead. - -\(fn TOPIC)" t nil) - -(autoload 'forge-browse-dwim "forge-commands" "\ -Visit a topic, branch or commit using a browser. -Prefer a topic over a branch and that over a commit." t nil) - -(autoload 'forge-browse-commit "forge-commands" "\ -Visit the url corresponding to REV using a browser. - -\(fn REV)" t nil) - -(autoload 'forge-copy-url-at-point-as-kill "forge-commands" "\ -Copy the url of the thing at point." t nil) - -(autoload 'forge-browse-branch "forge-commands" "\ -Visit the url corresponding BRANCH using a browser. - -\(fn BRANCH)" t nil) - -(autoload 'forge-browse-remote "forge-commands" "\ -Visit the url corresponding to REMOTE using a browser. - -\(fn REMOTE)" t nil) - -(autoload 'forge-browse-repository "forge-commands" "\ -View the current repository in a separate buffer. - -\(fn REPO)" t nil) - -(autoload 'forge-browse-topic "forge-commands" "\ -Visit the current topic using a browser." t nil) - -(autoload 'forge-browse-pullreqs "forge-commands" "\ -Visit the pull-requests of the current repository using a browser." t nil) - -(autoload 'forge-browse-pullreq "forge-commands" "\ -Visit the url corresponding to PULLREQ using a browser. - -\(fn PULLREQ)" t nil) - -(autoload 'forge-browse-issues "forge-commands" "\ -Visit the issues of the current repository using a browser." t nil) - -(autoload 'forge-browse-issue "forge-commands" "\ -Visit the current issue using a browser. -If there is no current issue or with a prefix argument -read an ISSUE to visit. - -\(fn ISSUE)" t nil) - -(autoload 'forge-browse-post "forge-commands" "\ -Visit the current post using a browser." t nil) - -(autoload 'forge-visit-topic "forge-commands" "\ -View the current topic in a separate buffer. -If there is no current topic or with a prefix argument -read a topic to visit instead. - -\(fn TOPIC)" t nil) - -(autoload 'forge-visit-pullreq "forge-commands" "\ -View the current pull-request in a separate buffer. -If there is no current pull-request or with a prefix argument -read a PULLREQ to visit instead. If point is looking at a pullreq -reference with Gitlab/Github notation try to visit the pullreq -with that number. - -\(fn PULLREQ)" t nil) - -(autoload 'forge-visit-issue "forge-commands" "\ -Visit the current issue in a separate buffer. -If there is no current issue or with a prefix argument read an -ISSUE to visit instead. If point is looking at an issue reference -with Gitlab/Github notation try to visit the issue with that -number. - -\(fn ISSUE)" t nil) - -(autoload 'forge-visit-repository "forge-commands" "\ -View the current repository in a separate buffer. - -\(fn REPO)" t nil) - -(autoload 'forge-branch-pullreq "forge-commands" "\ -Create and configure a new branch from a pull-request. -Please see the manual for more information. - -\(fn PULLREQ)" t nil) - -(autoload 'forge-checkout-pullreq "forge-commands" "\ -Create, configure and checkout a new branch from a pull-request. -Please see the manual for more information. - -\(fn PULLREQ)" t nil) - -(autoload 'forge-checkout-worktree "forge-commands" "\ -Create, configure and checkout a new worktree from a pull-request. -This is like `forge-checkout-pullreq', except that it also -creates a new worktree. Please see the manual for more -information. - -\(fn PATH PULLREQ)" t nil) - -(autoload 'forge-fork "forge-commands" "\ -Fork the current repository to FORK and add it as a REMOTE. -If the fork already exists, then that isn't an error; the remote -is added anyway. Currently this only supports Github and Gitlab. - -\(fn FORK REMOTE)" t nil) - -(autoload 'forge-list-notifications "forge-commands" "\ -List notifications." t nil) - -(autoload 'forge-add-pullreq-refspec "forge-commands" "\ -Configure Git to fetch all pull-requests. -This is done by adding \"+refs/pull/*/head:refs/pullreqs/*\" -to the value of `remote.REMOTE.fetch', where REMOTE is the -upstream remote. Also fetch from REMOTE." t nil) - -(autoload 'forge-add-repository "forge-commands" "\ -Add a repository to the database. -Offer to either pull topics (now and in the future) or to only -pull individual topics when the user invokes `forge-pull-topic'. - -\(fn URL)" t nil) - -(function-put 'forge-add-repository 'interactive-only 't) - -(autoload 'forge-add-user-repositories "forge-commands" "\ -Add all of USER's repositories from HOST to the database. -This may take a while. Only Github is supported at the moment. - -\(fn HOST USER)" t nil) - -(autoload 'forge-add-organization-repositories "forge-commands" "\ -Add all of ORGANIZATION's repositories from HOST to the database. -This may take a while. Only Github is supported at the moment. - -\(fn HOST ORGANIZATION)" t nil) - -(autoload 'forge-merge "forge-commands" "\ -Merge the current pull-request using METHOD using the forge's API. - -If there is no current pull-request or with a prefix argument, -then read pull-request PULLREQ to visit instead. - -Use of this command is discouraged. Unless the remote repository -is configured to disallow that, you should instead merge locally -and then push the target branch. Forges detect that you have -done that and respond by automatically marking the pull-request -as merged. - -\(fn PULLREQ METHOD)" t nil) - -(autoload 'forge-remove-repository "forge-commands" "\ -Remove a repository from the database. - -\(fn HOST OWNER NAME)" t nil) - -(autoload 'forge-remove-topic-locally "forge-commands" "\ -Remove a topic from the local database only. -Due to how the supported APIs work, it would be too expensive to -automatically remove topics from the local database that were -removed from the forge. The purpose of this command is to allow -you to manually clean up the local database. - -\(fn TOPIC)" t nil) - -(autoload 'forge-rename-default-branch "forge-commands" "\ -Rename the default branch to NEWNAME. -Change the name on the upstream remote and locally, and update -the upstream remotes of local branches accordingly." t nil) - -(autoload 'forge-reset-database "forge-commands" "\ -Move the current database file to the trash. -This is useful after the database scheme has changed, which will -happen a few times while the forge functionality is still under -heavy development." t nil) - -(register-definition-prefixes "forge-commands" '("forge-")) - -;;;*** - -;;;### (autoloads nil "forge-core" "forge-core.el" (0 0 0 0)) -;;; Generated autoloads from forge-core.el - -(register-definition-prefixes "forge-core" '("forge-")) - -;;;*** - -;;;### (autoloads nil "forge-db" "forge-db.el" (0 0 0 0)) -;;; Generated autoloads from forge-db.el - -(register-definition-prefixes "forge-db" '("forge-")) - -;;;*** - -;;;### (autoloads nil "forge-gitea" "forge-gitea.el" (0 0 0 0)) -;;; Generated autoloads from forge-gitea.el - -(register-definition-prefixes "forge-gitea" '("forge-gitea-repository")) - -;;;*** - -;;;### (autoloads nil "forge-github" "forge-github.el" (0 0 0 0)) -;;; Generated autoloads from forge-github.el - -(register-definition-prefixes "forge-github" '("forge-")) - -;;;*** - -;;;### (autoloads nil "forge-gitlab" "forge-gitlab.el" (0 0 0 0)) -;;; Generated autoloads from forge-gitlab.el - -(register-definition-prefixes "forge-gitlab" '("forge-gitlab-repository")) - -;;;*** - -;;;### (autoloads nil "forge-gogs" "forge-gogs.el" (0 0 0 0)) -;;; Generated autoloads from forge-gogs.el - -(register-definition-prefixes "forge-gogs" '("forge-gogs-repository")) - -;;;*** - -;;;### (autoloads nil "forge-issue" "forge-issue.el" (0 0 0 0)) -;;; Generated autoloads from forge-issue.el - -(register-definition-prefixes "forge-issue" '("forge-")) - -;;;*** - -;;;### (autoloads nil "forge-list" "forge-list.el" (0 0 0 0)) -;;; Generated autoloads from forge-list.el - -(autoload 'forge-list-topics "forge-list" "\ -List topics of the current repository in a separate buffer. - -\(fn ID)" t nil) - -(autoload 'forge-list-issues "forge-list" "\ -List issues of the current repository in a separate buffer. - -\(fn ID)" t nil) - -(autoload 'forge-list-labeled-issues "forge-list" "\ -List issues of the current repository that have LABEL. -List them in a separate buffer. - -\(fn ID LABEL)" t nil) - -(autoload 'forge-list-assigned-issues "forge-list" "\ -List issues of the current repository that are assigned to you. -List them in a separate buffer. - -\(fn ID)" t nil) - -(autoload 'forge-list-owned-issues "forge-list" "\ -List open issues from all your Github repositories. -Options `forge-owned-accounts' and `forge-owned-ignored' -controls which repositories are considered to be owned by you. -Only Github is supported for now." t nil) - -(autoload 'forge-list-pullreqs "forge-list" "\ -List pull-requests of the current repository in a separate buffer. - -\(fn ID)" t nil) - -(autoload 'forge-list-labeled-pullreqs "forge-list" "\ -List pull-requests of the current repository that have LABEL. -List them in a separate buffer. - -\(fn ID LABEL)" t nil) - -(autoload 'forge-list-assigned-pullreqs "forge-list" "\ -List pull-requests of the current repository that are assigned to you. -List them in a separate buffer. - -\(fn ID)" t nil) - -(autoload 'forge-list-requested-reviews "forge-list" "\ -List pull-requests of the current repository that are awaiting your review. -List them in a separate buffer. - -\(fn ID)" t nil) - -(autoload 'forge-list-owned-pullreqs "forge-list" "\ -List open pull-requests from all your Github repositories. -Options `forge-owned-accounts' and `forge-owned-ignored' -controls which repositories are considered to be owned by you. -Only Github is supported for now." t nil) - -(autoload 'forge-list-authored-pullreqs "forge-list" "\ -List open pull-requests of the current repository that are authored by you. -List them in a separate buffer. - -\(fn ID)" t nil) - -(autoload 'forge-list-authored-issues "forge-list" "\ -List open issues from the current repository that are authored by you. -List them in a separate buffer. - -\(fn ID)" t nil) - -(autoload 'forge-list-repositories "forge-list" "\ -List known repositories in a separate buffer. -Here \"known\" means that an entry exists in the local database." t nil) - -(autoload 'forge-list-owned-repositories "forge-list" "\ -List your own known repositories in a separate buffer. -Here \"known\" means that an entry exists in the local database -and options `forge-owned-accounts' and `forge-owned-ignored' -controls which repositories are considered to be owned by you. -Only Github is supported for now." t nil) - -(register-definition-prefixes "forge-list" '("forge-")) - -;;;*** - -;;;### (autoloads nil "forge-notify" "forge-notify.el" (0 0 0 0)) -;;; Generated autoloads from forge-notify.el - -(register-definition-prefixes "forge-notify" '("forge-")) - -;;;*** - -;;;### (autoloads nil "forge-post" "forge-post.el" (0 0 0 0)) -;;; Generated autoloads from forge-post.el - -(register-definition-prefixes "forge-post" '("forge-")) - -;;;*** - -;;;### (autoloads nil "forge-pullreq" "forge-pullreq.el" (0 0 0 0)) -;;; Generated autoloads from forge-pullreq.el - -(register-definition-prefixes "forge-pullreq" '("forge-")) - -;;;*** - -;;;### (autoloads nil "forge-repo" "forge-repo.el" (0 0 0 0)) -;;; Generated autoloads from forge-repo.el - -(register-definition-prefixes "forge-repo" '("forge-")) - -;;;*** - -;;;### (autoloads nil "forge-revnote" "forge-revnote.el" (0 0 0 0)) -;;; Generated autoloads from forge-revnote.el - -(register-definition-prefixes "forge-revnote" '("forge-revnote")) - -;;;*** - -;;;### (autoloads nil "forge-semi" "forge-semi.el" (0 0 0 0)) -;;; Generated autoloads from forge-semi.el - -(register-definition-prefixes "forge-semi" '("forge-")) - -;;;*** - -;;;### (autoloads nil "forge-topic" "forge-topic.el" (0 0 0 0)) -;;; Generated autoloads from forge-topic.el - -(register-definition-prefixes "forge-topic" '("forge-")) - -;;;*** - -;;;### (autoloads nil nil ("forge-pkg.el") (0 0 0 0)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; forge-autoloads.el ends here diff --git a/elpa/forge-20230505.926/forge-bitbucket.el b/elpa/forge-20230505.926/forge-bitbucket.el deleted file mode 100644 index c677e036..00000000 --- a/elpa/forge-20230505.926/forge-bitbucket.el +++ /dev/null @@ -1,46 +0,0 @@ -;;; forge-bitbucket.el --- Bitbucket support -*- lexical-binding:t -*- - -;; Copyright (C) 2018-2023 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-20230505.926/forge-commands.el b/elpa/forge-20230505.926/forge-commands.el deleted file mode 100644 index 859f3ce8..00000000 --- a/elpa/forge-20230505.926/forge-commands.el +++ /dev/null @@ -1,1139 +0,0 @@ -;;; forge-commands.el --- Commands -*- lexical-binding:t -*- - -;; Copyright (C) 2018-2023 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." - [["Fetch" - ("f f" "all topics" forge-pull) - ("f t" "one topic" forge-pull-topic) - ("f n" "notifications" forge-pull-notifications) - """Create" - ("c i" "issue" forge-create-issue) - ("c p" "pull-request" forge-create-pullreq) - ("c u" "pull-request from issue" forge-create-pullreq-from-issue - :if (lambda () (forge-github-repository-p (forge-get-repository nil)))) - ("c f" "fork or remote" forge-fork) - """Merge" - (7 "M " "merge using API" forge-merge)] - ["List" - ("l t" "topics" forge-list-topics) - ("l i" "issues" forge-list-issues) - ("l p" "pull-requests" forge-list-pullreqs) - ("l n" "notifications" forge-list-notifications) - ("l r" "repositories" forge-list-repositories) - (7 "l a" "awaiting review" forge-list-requested-reviews) - (7 "n i" "labeled issues" forge-list-labeled-issues) - (7 "n p" "labeled pull-requests" forge-list-labeled-pullreqs) - (7 "m i" "authored issues" forge-list-authored-issues) - (7 "m p" "authored pull-requests" forge-list-authored-pullreqs) - (7 "o i" "owned issues" forge-list-owned-issues) - (7 "o p" "owned pull-requests" forge-list-owned-pullreqs) - (7 "o r" "owned repositories" forge-list-owned-repositories)] - ["Visit" - ("v t" "topic" forge-visit-topic) - ("v i" "issue" forge-visit-issue) - ("v p" "pull-request" forge-visit-pullreq) - """Browse" - ("b I" "issues" forge-browse-issues) - ("b P" "pull-requests" forge-browse-pullreqs) - ("b t" "topic" forge-browse-topic) - ("b i" "issue" forge-browse-issue) - ("b p" "pull-request" forge-browse-pullreq) - ("b r" "remote" forge-browse-remote)]] - [["Configure" - ("a " "add repository to database" forge-add-repository) - ("r " "forge.remote" forge-forge.remote) - ("t l" "forge.graphqlItemLimit" forge-forge.graphqlItemLimit - :if (lambda () (forge-github-repository-p (forge-get-repository nil)))) - ("t t" forge-toggle-display-in-status-buffer) - ("t c" forge-toggle-closed-visibility)]]) - -;;; Pull - -;;;###autoload -(defun forge-pull (&optional repo until interactive) - "Pull topics from the forge repository. - -With a prefix argument and if the repository has not been fetched -before, then read a date from the user and limit pulled topics to -those that have been updated since then. - -If pulling is too slow, then also consider setting the Git variable -`forge.omitExpensive' to `true'. -\n(fn &optional REPO UNTIL)" - (interactive - (list nil - (and current-prefix-arg - (not (forge-get-repository 'full)) - (forge-read-date "Limit pulling to topics updates since: ")) - t)) - (let (create) - (unless repo - (setq repo (forge-get-repository 'full)) - (unless repo - (setq repo (forge-get-repository 'create)) - (setq create t))) - (when (or create interactive (magit-git-config-p "forge.autoPull" t)) - (forge--zap-repository-cache repo) - (when (and interactive - (oref repo selective-p) - (yes-or-no-p - (format "Always pull all of %s/%s's topics going forward?" - (oref repo owner) - (oref repo name)))) - (oset repo selective-p nil)) - (setq forge--mode-line-buffer (current-buffer)) - (when-let* ((remote (oref repo remote)) - (refspec (oref repo pullreq-refspec))) - (when (and create - (not (member refspec (magit-get-all "remote" remote "fetch"))) - (or (eq forge-add-pullreq-refspec t) - (and (eq forge-add-pullreq-refspec 'ask) - (y-or-n-p (format "Also add %S refspec? " refspec))))) - (magit-call-git "config" "--add" - (format "remote.%s.fetch" remote) - refspec))) - (forge--msg repo t nil "Pulling REPO") - (forge--pull repo until)))) - -(defun forge-read-date (prompt) - (cl-block nil - (while t - (let ((str (read-from-minibuffer prompt))) - (cond ((string-equal str "") - (cl-return nil)) - ((string-match-p - "\\`[0-9]\\{4\\}[-/][0-9]\\{2\\}[-/][0-9]\\{2\\}\\'" str) - (cl-return str)))) - (message "Please enter a date in the format YYYY-MM-DD.") - (sit-for 1)))) - -(cl-defmethod forge--pull ((repo forge-noapi-repository) _until) ; NOOP - (forge--msg repo t t "Pulling from REPO is not supported")) - -(cl-defmethod forge--pull ((repo forge-unusedapi-repository) _until) - (oset repo sparse-p nil) - (magit-git-fetch (oref repo remote) (magit-fetch-arguments))) - -(defun forge--git-fetch (buf dir repo) - (if (buffer-live-p buf) - (with-current-buffer buf - (magit-git-fetch (oref repo remote) (magit-fetch-arguments))) - (let ((default-directory dir)) - (magit-git-fetch (oref repo remote) (magit-fetch-arguments))))) - -;;;###autoload -(defun forge-pull-notifications () - "Fetch notifications for all repositories from the current forge." - (interactive) - (let* ((repo (forge-get-repository 'stub)) - (class (eieio-object-class repo))) - (if (eq class 'forge-github-repository) - (forge--pull-notifications class (oref repo githost)) - (user-error "Fetching notifications not supported for forge %S" - (oref repo forge))))) - -;;;###autoload -(defun forge-pull-topic (topic) - "Pull the API data for the current topic. -If there is no current topic or with a prefix argument read a -TOPIC to pull instead." - (interactive (list (forge-read-topic "Pull topic" nil t))) - (let ((repo (forge-get-repository t))) - (forge--zap-repository-cache repo) - (forge--pull-topic repo - (if (numberp topic) - (forge-issue :repository (oref repo id) - :number topic) - (forge-get-topic topic))))) - -(cl-defmethod forge--pull-topic ((repo forge-repository) _topic) - (error "Fetching an individual topic not implemented for %s" - (eieio-object-class repo))) - -(defun forge--zap-repository-cache (&optional repo) - (when-let ((r (if repo - (oref repo worktree) - (magit-repository-local-repository)))) - (magit-repository-local-delete (list 'forge-ls-recent-topics 'issue) r) - (magit-repository-local-delete (list 'forge-ls-recent-topics 'pullreq) r))) - -;;; Browse - -;;;###autoload -(defun forge-browse-dwim () - "Visit a topic, branch or commit using a browser. -Prefer a topic over a branch and that over a commit." - (interactive) - (if-let ((topic (forge-topic-at-point))) - (forge-browse topic) - (if-let ((branch (magit-branch-at-point))) - (forge-browse-branch branch) - (call-interactively #'forge-browse-commit)))) - -;;;###autoload -(defun forge-browse-commit (rev) - "Visit the url corresponding to REV using a browser." - (interactive - (list (or (magit-completing-read "Browse commit" - (magit-list-branch-names) - nil nil nil 'magit-revision-history - (magit-branch-or-commit-at-point)) - (user-error "Nothing selected")))) - (let ((repo (forge-get-repository 'stub))) - (unless (magit-list-containing-branches - rev "-r" (concat (oref repo remote) "/*")) - (if-let ((branch (car (magit-list-containing-branches rev "-r")))) - (setq repo (forge-get-repository - 'stub (cdr (magit-split-branch-name branch)))) - (message "%s does not appear to be available on any remote. %s" - rev "You might have to push it first."))) - (browse-url - (forge--format repo 'commit-url-format - `((?r . ,(magit-commit-p rev))))))) - -;;;###autoload -(defun forge-copy-url-at-point-as-kill () - "Copy the url of the thing at point." - (interactive) - (if-let ((url (forge-get-url (or (forge-post-at-point) - (forge-current-topic))))) - (progn - (kill-new url) - (message "Copied %S" url)) - (user-error "Nothing at point with a URL"))) - -;;;###autoload -(defun forge-browse-branch (branch) - "Visit the url corresponding BRANCH using a browser." - (interactive (list (magit-read-branch "Browse branch"))) - (let (remote) - (if (magit-remote-branch-p branch) - (let ((cons (magit-split-branch-name branch))) - (setq remote (car cons)) - (setq branch (cdr cons))) - (or (setq remote (or (magit-get-push-remote branch) - (magit-get-upstream-remote branch))) - (user-error "Cannot determine remote for %s" branch))) - (browse-url (forge--format remote 'branch-url-format - `((?r . ,branch)))))) - -;;;###autoload -(defun forge-browse-remote (remote) - "Visit the url corresponding to REMOTE using a browser." - (interactive (list (magit-read-remote "Browse remote"))) - (browse-url (forge--format remote 'remote-url-format))) - -;;;###autoload -(defun forge-browse-repository (repo) - "View the current repository in a separate buffer." - (interactive - (list (or (forge-current-repository) - (forge-get-repository - (forge-read-repository "Browse repository"))))) - (browse-url (forge--format repo 'remote-url-format))) - -;;;###autoload -(defun forge-browse-topic () - "Visit the current topic using a browser." - (interactive) - (if-let ((topic (forge-current-topic))) - (forge-browse topic) - (user-error "There is no current topic"))) - -;;;###autoload -(defun forge-browse-pullreqs () - "Visit the pull-requests of the current repository using a browser." - (interactive) - (browse-url (forge--format (forge-get-repository 'stub) - 'pullreqs-url-format))) - -;;;###autoload -(defun forge-browse-pullreq (pullreq) - "Visit the url corresponding to PULLREQ using a browser." - (interactive (list (forge-read-pullreq "Browse pull-request" t))) - (forge-browse (forge-get-pullreq pullreq))) - -;;;###autoload -(defun forge-browse-issues () - "Visit the issues of the current repository using a browser." - (interactive) - (browse-url (forge--format (forge-get-repository 'stub) - 'issues-url-format))) - -;;;###autoload -(defun forge-browse-issue (issue) - "Visit the current issue using a browser. -If there is no current issue or with a prefix argument -read an ISSUE to visit." - (interactive (list (forge-read-issue "Browse issue" t))) - (forge-browse (forge-get-issue issue))) - -;;;###autoload -(defun forge-browse-post () - "Visit the current post using a browser." - (interactive) - (if-let ((post (forge-post-at-point))) - (forge-browse post) - (user-error "There is no current post"))) - -;;; Visit - -;;;###autoload -(defun forge-visit-topic (topic) - "View the current topic in a separate buffer. -If there is no current topic or with a prefix argument -read a topic to visit instead." - (interactive (list (if-let ((topic (forge-current-topic))) - (oref topic id) - (forge-read-topic "View topic")))) - (forge-visit (forge-get-topic topic))) - -;;;###autoload -(defun forge-visit-pullreq (pullreq) - "View the current pull-request in a separate buffer. -If there is no current pull-request or with a prefix argument -read a PULLREQ to visit instead. If point is looking at a pullreq -reference with Gitlab/Github notation try to visit the pullreq -with that number." - (interactive (list (forge-read-pullreq "View pull-request" t))) - (forge-visit (forge-get-pullreq pullreq))) - -;;;###autoload -(defun forge-visit-issue (issue) - "Visit the current issue in a separate buffer. -If there is no current issue or with a prefix argument read an -ISSUE to visit instead. If point is looking at an issue reference -with Gitlab/Github notation try to visit the issue with that -number." - (interactive (list (forge-read-issue "View issue" t))) - (forge-visit (forge-get-issue issue))) - -;;;###autoload -(defun forge-visit-repository (repo) - "View the current repository in a separate buffer." - (interactive - (list (or (forge-current-repository) - (forge-get-repository - (forge-read-repository "Visit repository"))))) - (forge-visit repo)) - -;;; Create - -(defun forge-create-pullreq (source target) - "Create a new pull-request for the current repository." - (interactive (forge-create-pullreq--read-args)) - (let* ((repo (forge-get-repository t)) - (buf (forge--prepare-post-buffer - "new-pullreq" - (forge--format repo "Create new pull-request on %p") - source target))) - (with-current-buffer buf - (setq forge--buffer-base-branch target) - (setq forge--buffer-head-branch source) - (setq forge--buffer-post-object repo) - (setq forge--submit-post-function #'forge--submit-create-pullreq) - (run-hooks 'forge-create-pullreq-hook)) - (forge--display-post-buffer buf))) - -(defun forge-create-pullreq-from-issue (issue source target) - "Convert an existing ISSUE into a pull-request." - (interactive (cons (forge-read-issue "Convert issue") - (forge-create-pullreq--read-args))) - (setq issue (forge-get-issue issue)) - (forge--create-pullreq-from-issue (forge-get-repository issue) - issue source target)) - -(defun forge-create-pullreq--read-args () - (let* ((source (magit-completing-read - "Source branch" - (magit-list-remote-branch-names) - nil t nil 'magit-revision-history - (or (and-let* ((d (magit-branch-at-point))) - (if (magit-remote-branch-p d) - d - (magit-get-push-branch d t))) - (and-let* ((d (magit-get-current-branch))) - (if (magit-remote-branch-p d) - d - (magit-get-push-branch d t)))))) - (repo (forge-get-repository t)) - (remote (oref repo remote)) - (targets (delete source (magit-list-remote-branch-names remote))) - (target (magit-completing-read - "Target branch" targets nil t nil 'magit-revision-history - (let* ((d (cdr (magit-split-branch-name source))) - (d (and (magit-branch-p d) d)) - (d (and d (magit-get-upstream-branch d))) - (d (and d (if (magit-remote-branch-p d) - d - (magit-get-upstream-branch d)))) - (d (or d (concat remote "/" - (or (oref repo default-branch) - "master"))))) - (car (member d targets)))))) - (list source target))) - -(defun forge-create-issue () - "Create a new issue for the current repository." - (interactive) - (let* ((repo (forge-get-repository t)) - (buf (forge--prepare-post-buffer - "new-issue" - (forge--format repo "Create new issue on %p")))) - (when buf - (with-current-buffer buf - (setq forge--buffer-post-object repo) - (setq forge--submit-post-function #'forge--submit-create-issue)) - (forge--display-post-buffer buf)))) - -(defun forge-create-post (&optional quote) - "Create a new post on an existing topic. -If the region is active, then quote that part of the post. -Otherwise and with a prefix argument quote the post that -point is currently on." - (interactive (list current-prefix-arg)) - (unless (derived-mode-p 'forge-topic-mode) - (user-error "This command is only available from topic buffers")) - (let* ((topic forge-buffer-topic) - (buf (forge--prepare-post-buffer - (forge--format topic "%i;new-comment") - (forge--format topic "New comment on #%i of %p"))) - (quote (cond - ((not (magit-section-match 'post)) nil) - ((use-region-p) - (buffer-substring-no-properties (region-beginning) - (region-end))) - (quote - (let ((section (magit-current-section))) - (string-trim-right - (buffer-substring-no-properties (oref section content) - (oref section end)))))))) - (with-current-buffer buf - (setq forge--buffer-post-object topic) - (setq forge--submit-post-function #'forge--submit-create-post) - (when quote - (goto-char (point-max)) - (unless (bobp) - (insert "\n")) - (insert (replace-regexp-in-string "^" "> " quote) "\n\n"))) - (forge--display-post-buffer buf))) - -;;; Edit - -(defun forge-edit-post () - "Edit the current post." - (interactive) - (let* ((post (or (forge-post-at-point) - (user-error "There is no current post"))) - (buf (cl-typecase post - (forge-topic - (forge--prepare-post-buffer - (forge--format post "%i") - (forge--format post "Edit #%i of %p"))) - (forge-post - (forge--prepare-post-buffer - (forge--format post "%i;%I") - (forge--format post "Edit comment on #%i of %p")))))) - (with-current-buffer buf - (setq forge--buffer-post-object post) - (setq forge--submit-post-function #'forge--submit-edit-post) - (erase-buffer) - (when (cl-typep post 'forge-topic) - (insert "# " (oref post title) "\n\n")) - (insert (oref post body))) - (forge--display-post-buffer buf))) - -(defun forge-edit-topic-title (topic) - "Edit the title of the current topic. -If there is no current topic or with a prefix argument read a -TOPIC and modify that instead." - (interactive (list (forge-read-topic "Edit title of"))) - (let ((topic (forge-get-topic topic))) - (forge--set-topic-title - (forge-get-repository topic) topic - (read-string "Title: " (oref topic title))))) - -(defun forge-edit-topic-state (topic) - "Close or reopen the current topic. -If there is no current topic or with a prefix argument read a -TOPIC and modify that instead." - (interactive - (let* ((id (forge-read-topic "Close/reopen")) - (topic (forge-get-topic id))) - (if (magit-y-or-n-p - (format "%s %S" - (cl-ecase (oref topic state) - (merged (error "Merged pull-requests cannot be reopened")) - (closed "Reopen") - (open "Close")) - (car (forge--topic-format-choice topic)))) - (list id) - (user-error "Abort")))) - (let ((topic (forge-get-topic topic))) - (forge--set-topic-state (forge-get-repository topic) topic))) - -(defun forge-edit-topic-draft (pullreq) - "Toggle whether the current pull-request is a draft. -If there is no current topic or with a prefix argument read a -TOPIC and modify that instead." - (interactive (list (forge-read-pullreq "Toggle draft state of"))) - (let ((pullreq (forge-get-pullreq pullreq))) - (forge--set-topic-draft (forge-get-repository pullreq) - pullreq - (not (oref pullreq draft-p))))) - -(defun forge-edit-topic-milestone (topic) - (interactive (list (forge-read-topic "Edit milestone of"))) - (let* ((topic (forge-get-topic topic)) - (repo (forge-get-repository topic))) - (forge--set-topic-milestone - repo topic - (magit-completing-read - "Milestone" - (mapcar #'caddr (oref repo milestones)) - nil t (forge--get-topic-milestone topic))))) - -(defun forge-edit-topic-labels (topic) - "Edit the labels of the current topic. -If there is no current topic or with a prefix argument read a -TOPIC and modify that instead." - (interactive (list (forge-read-topic "Edit labels of"))) - (let* ((topic (forge-get-topic topic)) - (repo (forge-get-repository topic)) - (crm-separator ",")) - (forge--set-topic-labels - repo topic (magit-completing-read-multiple - "Labels: " - (mapcar #'cadr (oref repo labels)) - nil t - (mapconcat #'car (closql--iref topic 'labels) ","))))) - -(defun forge-edit-topic-marks (topic marks) - "Edit the marks of the current topic. -If there is no current topic or with a prefix argument read a -TOPIC and modify that instead." - (interactive - (let ((topic (forge-read-topic "Edit marks of"))) - (list topic (forge-read-marks "Marks: " (forge-get-topic topic))))) - (oset (forge-get-topic topic) marks marks) - (magit-refresh)) - -(defun forge-edit-topic-assignees (topic) - "Edit the assignees of the current topic. -If there is no current topic or with a prefix argument read a -TOPIC and modify that instead." - (interactive (list (forge-read-topic "Edit assignees of"))) - (let* ((topic (forge-get-topic topic)) - (repo (forge-get-repository topic)) - (value (closql--iref topic 'assignees)) - (choices (mapcar #'cadr (oref repo assignees))) - (crm-separator ",")) - (forge--set-topic-assignees - repo topic - (magit-completing-read-multiple - "Assignees: " choices nil - (if (forge--childp repo 'forge-gitlab-repository) - t ; Selecting something else would fail later on. - 'confirm) - (mapconcat #'car value ","))))) - -(defun forge-edit-topic-review-requests (pullreq) - "Edit the review-requests of the current pull-request. -If there is no current topic or with a prefix argument read a -PULLREQ and modify that instead." - (interactive (list (forge-read-pullreq "Request review for"))) - (let* ((topic (forge-get-pullreq pullreq)) - (repo (forge-get-repository topic)) - (value (closql--iref topic 'review-requests)) - (choices (mapcar #'cadr (oref repo assignees))) - (crm-separator ",")) - (forge--set-topic-review-requests - repo topic - (magit-completing-read-multiple - "Request review from: " choices nil - 'confirm - (mapconcat #'car value ","))))) - -(defun forge-edit-topic-note (topic) - "Edit your private note about the current topic. -If there is no current topic or with a prefix argument read a -TOPIC and modify that instead." - (interactive (list (forge-read-topic "Edit note about"))) - (let* ((topic (forge-get-topic topic)) - (buf (forge--prepare-post-buffer - (forge--format topic "%i;note") - (forge--format topic "New note on #%i of %p")))) - (with-current-buffer buf - (setq forge--buffer-post-object topic) - (setq forge--submit-post-function #'forge--save-note) - (erase-buffer) - (when-let ((note (oref topic note))) - (save-excursion (insert note ?\n)))) - (forge--display-post-buffer buf))) - -;;; Delete - -(defun forge-delete-comment (comment) - "Delete the comment at point." - (interactive (list (or (forge-comment-at-point) - (user-error "There is no comment at point")))) - (when (yes-or-no-p "Do you really want to delete the selected comment? ") - (forge--delete-comment (forge-get-repository t) comment))) - -;;; Branch - -;;;###autoload -(defun forge-branch-pullreq (pullreq) - "Create and configure a new branch from a pull-request. -Please see the manual for more information." - (interactive (list (forge-read-pullreq "Branch pull request" t))) - (let ((pullreq (forge-get-pullreq pullreq))) - (if-let ((branch (forge--pullreq-branch-active pullreq))) - (progn (message "Branch %S already exists and is configured" branch) - branch) - (forge--branch-pullreq (forge-get-repository pullreq) pullreq) - (magit-refresh)))) - -(cl-defmethod forge--branch-pullreq ((pullreq forge-pullreq)) - (forge--branch-pullreq (forge-get-repository pullreq) pullreq)) - -(cl-defmethod forge--branch-pullreq ((_repo forge-unusedapi-repository) pullreq) - ;; We don't know enough to do a good job. - (let* ((number (oref pullreq number)) - (branch (format "pr-%s" number))) - (when (magit-branch-p branch) - (user-error "Branch `%s' already exists" branch)) - (magit-git "branch" branch (forge--pullreq-ref pullreq)) - ;; More often than not this is the correct target branch. - (magit-call-git "branch" branch "--set-upstream-to=master") - (magit-set (number-to-string number) "branch" branch "pullRequest") - branch)) - -(cl-defmethod forge--branch-pullreq ((repo forge-repository) pullreq) - (let* ((number (oref pullreq number)) - (branch-n (format "pr-%s" number)) - (branch (or (forge--pullreq-branch-internal pullreq) branch-n)) - (pullreq-ref (format "refs/pullreqs/%s" number))) - (cond ((and-let* ((pr-branch (oref pullreq head-ref))) - (string-search ":" pr-branch)) - ;; Such a branch name would be invalid. If we encounter - ;; it anyway, then that means that the source branch and - ;; the merge-request ref are missing. Luckily Gitlab no - ;; longer does this, but we nevertheless have to deal - ;; with merge-requests that have been lost in time. - (error "Cannot check out this merge-request because %s" - "on old Gitlab version discarded the source branch")) - ((not (eq (oref pullreq state) 'open)) - (magit-git "branch" "--force" branch pullreq-ref)) - (t - (let ((upstream (oref repo remote)) - (pr-remote (oref pullreq head-user)) - (pr-branch (oref pullreq head-ref))) - (cond ((not (oref pullreq cross-repo-p)) - (let ((tracking (concat upstream "/" pr-branch))) - (unless (magit-branch-p tracking) - (magit-call-git "fetch" upstream)) - (forge--setup-pullreq-branch branch tracking) - (magit-branch-maybe-adjust-upstream branch tracking) - (magit-set upstream "branch" branch "pushRemote") - (magit-set upstream "branch" branch "pullRequestRemote"))) - ((not pr-branch) - ;; The pullreq branch (on Github) has been deleted. - (setq pr-remote nil) - (setq branch branch-n) - (forge--setup-pullreq-branch branch pullreq-ref) - (magit-set upstream "branch" branch "pushRemote")) - (t - ;; For prs within the upstream we are more permissive, - ;; but any request to merge a branch with a well known - ;; name from fork, is highly suspicious and likely the - ;; result of a contributor not bothering to name their - ;; feature branch. - (when (and (member branch magit-main-branch-names) - (magit-branch-p branch)) - (setq branch branch-n)) - (forge--setup-pullreq-remote pullreq) - (forge--setup-pullreq-branch - branch (concat pr-remote "/" pr-branch)) - (if (and (oref pullreq editable-p) - (equal branch pr-branch)) - (magit-set pr-remote "branch" branch "pushRemote") - (magit-set upstream "branch" branch "pushRemote")))) - (when pr-remote - (magit-set pr-remote "branch" branch "pullRequestRemote")) - (magit-set "true" "branch" branch "rebase") - (magit-git "branch" branch - (let ((base-ref (oref pullreq base-ref))) - (concat "--set-upstream-to=" - (if (or magit-branch-prefer-remote-upstream - (not (magit-branch-p base-ref))) - (concat upstream "/" base-ref) - base-ref))))))) - (magit-set (number-to-string number) "branch" branch "pullRequest") - (magit-set (oref pullreq title) "branch" branch "description") - branch)) - -(defun forge--setup-pullreq-branch (branch tracking) - (if (magit-branch-p branch) - (unless (magit-rev-equal branch tracking) - (message "Existing branch %s diverged from %s" branch tracking)) - (magit-git "branch" branch tracking))) - -(defun forge--setup-pullreq-remote (pullreq) - (let* ((pr-remote (oref pullreq head-user)) - (pr-branch (oref pullreq head-ref)) - (repo (forge-get-repository pullreq)) - (host (oref repo githost)) - (fork (oref pullreq head-repo))) - (if (magit-remote-p pr-remote) - (let ((url (magit-git-string "remote" "get-url" pr-remote)) - (fetch (magit-get-all "remote" pr-remote "fetch"))) - (unless (forge--url-equal url (format "git@%s:%s.git" host fork)) - (user-error "Remote `%s' already exists but does not point to %s" - pr-remote url)) - (unless (or (member (format "+refs/heads/*:refs/remotes/%s/*" - pr-remote) - fetch) - (member (format "+refs/heads/%s:refs/remotes/%s/%s" - pr-branch pr-remote pr-branch) - fetch)) - (magit-git "remote" "set-branches" "--add" pr-remote pr-branch) - (magit-git "fetch" pr-remote))) - (let ((url (magit-git-string "remote" "get-url" (oref repo remote)))) - (magit-git - "remote" "add" "-f" "--no-tags" - "-t" pr-branch pr-remote - (cond ((or (string-prefix-p "git@" url) - (string-prefix-p "ssh://git@" url)) - (format "git@%s:%s.git" host fork)) - ((string-prefix-p "https://" url) - (format "https://%s/%s.git" host fork)) - ((string-prefix-p "git://" url) - (format "git://%s/%s.git" host fork)) - ((string-prefix-p "http://" url) - (format "http://%s/%s.git" host fork)) - ((error "%s has an unexpected format" url)))))))) - -;;;###autoload -(defun forge-checkout-pullreq (pullreq) - "Create, configure and checkout a new branch from a pull-request. -Please see the manual for more information." - (interactive (list (forge-read-pullreq "Checkout pull request" t))) - (magit-checkout (forge--branch-pullreq (forge-get-pullreq pullreq)))) - -;;;###autoload -(defun forge-checkout-worktree (path pullreq) - "Create, configure and checkout a new worktree from a pull-request. -This is like `forge-checkout-pullreq', except that it also -creates a new worktree. Please see the manual for more -information." - (interactive - (let ((id (forge-read-pullreq "Checkout pull request" t))) - (list (funcall forge-checkout-worktree-read-directory-function - (forge-get-pullreq id)) - id))) - (when (and (file-exists-p path) - (not (and (file-directory-p path) - (length= (directory-files path) 2)))) - (user-error "%s already exists and isn't empty" path)) - (magit-worktree-checkout path - (forge--branch-pullreq (forge-get-pullreq pullreq)))) - -(defun forge-checkout-worktree-default-read-directory-function (pullreq) - (with-slots (number head-ref) pullreq - (let ((path (read-directory-name - (format "Checkout #%s in new worktree: " number) - (file-name-directory - (directory-file-name default-directory)) - nil nil - (let ((branch (forge--pullreq-branch-internal pullreq))) - (if (string-match-p "\\`pr-[0-9]+\\'" branch) - (number-to-string number) - (format "%s-%s" number - (string-replace "/" "-" head-ref))))))) - (when (equal path "") - (user-error "The empty string isn't a valid path")) - path))) - -;;; Marks - -(defun forge-create-mark (name face description) - "Define a new mark that topics can be marked with." - (interactive - (list (read-string "Name: ") - (magit-read-char-case "Set appearance using " nil - (?n "a face [n]ame" - (read-face-name "Face name: ")) - (?s "face [s]exp" - (read-from-minibuffer - "Face sexp: " - "(:background \"\" :foreground \"\" :box t)" - read-expression-map t))) - (let ((str (read-string "Description: "))) - (and (not (equal str "")) str)))) - (forge-sql [:insert-into mark :values $v1] - (vector nil (forge--uuid) name face description))) - -(defun forge-edit-mark (id name face description) - "Define a new mark that topics can be marked with." - (interactive - (pcase-let ((`(,id ,name ,face ,description) - (forge-read-mark "Edit mark"))) - (list id - (read-string "Name: " name) - (magit-read-char-case "Set appearance using " nil - (?n "a face [n]ame" - (read-face-name "Face name: " (and (symbolp face) face))) - (?s "face [s]exp" - (read-from-minibuffer - "Face sexp: " - (if (listp face) - (format "%S" face) - "(:background \"\" :foreground \"\" :box t)") - read-expression-map t))) - (let ((str (read-string "Description: " nil nil description))) - (and (not (equal str "")) str))))) - (forge-sql [:update mark - :set (= [name face description] $v1) - :where (= id $s2)] - (vector name face description) id)) - -(defun forge-read-mark (prompt) - "Read a topic. Return (ID NAME FACE DESCRIPTION)." - (let* ((marks (forge-sql [:select [id name face description] :from mark])) - (name (completing-read prompt (mapcar #'cadr marks) nil t))) - (--first (equal (cadr it) name) marks))) - -(defun forge-read-marks (prompt &optional topic) - "Read multiple mark names and return the respective ids." - (let ((marks (forge-sql [:select [name id] :from mark])) - (crm-separator ",")) - (--map (cadr (assoc it marks)) - (magit-completing-read-multiple - prompt (mapcar #'car marks) nil t - (and topic - (mapconcat #'car (closql--iref topic 'marks) ",")))))) - -(defun forge-toggle-mark (mark) - "Toggle MARK for the current topic." - (if-let ((topic (forge-current-topic))) - (let* ((value (mapcar #'car (closql--iref topic 'marks))) - (value (if (member mark value) - (delete mark value) - (cons mark value))) - (marks (forge-sql [:select [name id] :from mark]))) - (oset topic marks (--map (cadr (assoc it marks)) value)) - (magit-refresh)) - (user-error "There is no topic at point"))) - -;;; Fork - -;;;###autoload -(defun forge-fork (fork remote) - "Fork the current repository to FORK and add it as a REMOTE. -If the fork already exists, then that isn't an error; the remote -is added anyway. Currently this only supports Github and Gitlab." - (interactive - (let ((fork (magit-completing-read "Fork to" - (mapcar #'car forge-owned-accounts)))) - (list fork - (read-string "Remote name: " - (or (plist-get (cdr (assoc fork forge-owned-accounts)) - 'remote-name) - fork))))) - (let ((repo (forge-get-repository 'stub))) - (forge--fork-repository repo fork) - (magit-remote-add remote - (magit-clone--format-url (oref repo githost) fork - (oref repo name)) - (list "--fetch")))) - -;;; Misc - -(transient-define-infix forge-forge.remote () - "Change the local value of the `forge.remote' Git variable." - :class 'magit--git-variable:choices - :variable "forge.remote" - :choices #'magit-list-remotes - :default (lambda (_) (forge--get-remote t))) - -;;;###autoload -(defun forge-list-notifications () - "List notifications." - (interactive) - (forge-notifications-setup-buffer)) - -(transient-define-suffix forge-toggle-display-in-status-buffer () - "Toggle whether to display topics in the current status buffer." - :description (lambda () - (if forge-display-in-status-buffer - "hide all topics" - "display topics")) - (interactive) - (setq forge-display-in-status-buffer (not forge-display-in-status-buffer)) - (magit-refresh)) - -(transient-define-suffix forge-toggle-closed-visibility () - "Toggle whether to display recently closed topics. -This only affect the current status buffer." - :description (lambda () - (if (or (atom forge-topic-list-limit) - (> (cdr forge-topic-list-limit) 0)) - "hide closed topics" - "display recently closed topics")) - :inapt-if-not (lambda () forge-display-in-status-buffer) - (interactive) - (magit-repository-local-delete (list 'forge-ls-recent-topics 'issue)) - (magit-repository-local-delete (list 'forge-ls-recent-topics 'pullreq)) - (make-local-variable 'forge-topic-list-limit) - (if (atom forge-topic-list-limit) - (setq forge-topic-list-limit (cons forge-topic-list-limit 5)) - (setcdr forge-topic-list-limit (* -1 (cdr forge-topic-list-limit)))) - (magit-refresh)) - -(transient-define-infix forge-forge.graphqlItemLimit () - "Change the maximum number of GraphQL entities to pull at once." - :class 'magit--git-variable - :variable "forge.graphqlItemLimit" - :reader #'read-string - :default (lambda () (number-to-string ghub-graphql-items-per-request))) - -;;;###autoload -(defun forge-add-pullreq-refspec () - "Configure Git to fetch all pull-requests. -This is done by adding \"+refs/pull/*/head:refs/pullreqs/*\" -to the value of `remote.REMOTE.fetch', where REMOTE is the -upstream remote. Also fetch from REMOTE." - (interactive) - (let* ((repo (forge-get-repository 'stub)) - (remote (oref repo remote)) - (fetch (magit-get-all "remote" remote "fetch")) - (refspec (oref repo pullreq-refspec))) - (if (member refspec fetch) - (message "Pull-request refspec is already active") - (magit-call-git "config" "--add" - (format "remote.%s.fetch" remote) - refspec) - (magit-git-fetch remote (magit-fetch-arguments))))) - -;;;###autoload -(defun forge-add-repository (url) - "Add a repository to the database. -Offer to either pull topics (now and in the future) or to only -pull individual topics when the user invokes `forge-pull-topic'." - (declare (interactive-only t)) - (interactive - (let ((str (magit-read-string-ns - "Add repository to database (url or name)" - (and-let* ((repo (forge-get-repository 'stub)) - (remote (oref repo remote))) - (magit-git-string "remote" "get-url" remote))))) - (if (string-match-p "\\(://\\|@\\)" str) - (list str) - (list (magit-clone--name-to-url str))))) - (if (forge-get-repository url nil 'full) - (user-error "%s is already tracked in Forge database" url) - (let ((repo (forge-get-repository url nil 'create))) - (oset repo sparse-p nil) - (magit-read-char-case "Pull " nil - (?a "[a]ll topics" - (forge-pull repo)) - (?i "[i]ndividual topics (useful for casual contributors)" - (oset repo selective-p t) - (forge--pull repo nil)))))) - -;;;###autoload -(defun forge-add-user-repositories (host user) - "Add all of USER's repositories from HOST to the database. -This may take a while. Only Github is supported at the moment." - (interactive - (list (forge-read-host "Add repositories from Github host" - 'forge-github-repository) - (read-string "User: "))) - (forge--add-user-repos 'forge-github-repository host user)) - -;;;###autoload -(defun forge-add-organization-repositories (host organization) - "Add all of ORGANIZATION's repositories from HOST to the database. -This may take a while. Only Github is supported at the moment." - (interactive - (list (forge-read-host "Add repositories from Github host" - 'forge-github-repository) - (read-string "Organization: "))) - (forge--add-organization-repos 'forge-github-repository host organization)) - -;;;###autoload -(defun forge-merge (pullreq method) - "Merge the current pull-request using METHOD using the forge's API. - -If there is no current pull-request or with a prefix argument, -then read pull-request PULLREQ to visit instead. - -Use of this command is discouraged. Unless the remote repository -is configured to disallow that, you should instead merge locally -and then push the target branch. Forges detect that you have -done that and respond by automatically marking the pull-request -as merged." - (interactive - (list (forge-read-pullreq "Merge pull-request" t) - (if (forge--childp (forge-get-repository t) 'forge-gitlab-repository) - (magit-read-char-case "Merge method " t - (?m "[m]erge" 'merge) - (?s "[s]quash" 'squash)) - (magit-read-char-case "Merge method " t - (?m "[m]erge" 'merge) - (?s "[s]quash" 'squash) - (?r "[r]ebase" 'rebase))))) - (let ((pullreq (forge-get-pullreq pullreq))) - (forge--merge-pullreq (forge-get-repository pullreq) - pullreq - (magit-rev-hash - (forge--pullreq-branch-internal pullreq)) - method)) - (forge-pull)) - -;;;###autoload -(defun forge-remove-repository (host owner name) - "Remove a repository from the database." - (interactive - (pcase-let ((`(,githost ,owner ,name) - (forge-read-repository "Remove repository from db"))) - (if (yes-or-no-p - (format "Do you really want to remove \"%s/%s @%s\" from the db? " - owner name githost)) - (list githost owner name) - (user-error "Abort")))) - (closql-delete (forge-get-repository (list host owner name))) - (magit-refresh)) - -;;;###autoload -(defun forge-remove-topic-locally (topic) - "Remove a topic from the local database only. -Due to how the supported APIs work, it would be too expensive to -automatically remove topics from the local database that were -removed from the forge. The purpose of this command is to allow -you to manually clean up the local database." - (interactive (list (forge-read-topic "Delete topic LOCALLY only"))) - (setq topic (forge-get-topic topic)) - (closql-delete topic) - (if (and (derived-mode-p 'forge-topic-mode) - (eq (oref topic id) - (oref forge-buffer-topic id))) - (kill-buffer (current-buffer)) - (magit-refresh))) - -;;;###autoload -(defun forge-rename-default-branch () - "Rename the default branch to NEWNAME. -Change the name on the upstream remote and locally, and update -the upstream remotes of local branches accordingly." - (interactive) - (let* ((repo (forge-get-repository 'full)) - (_ (unless (forge-github-repository-p repo) - (user-error "Updating default branch not supported for forge `%s'" - (oref repo forge)))) - (remote (or (and (fboundp 'forge--get-remote) - (forge--get-remote)) - (magit-get-some-remote) - (user-error "No remote configured"))) - (symref (format "refs/remotes/%s/HEAD" remote)) - (oldhead (progn - (message "Determining old default branch...") - (magit-git "fetch" "--prune") - (magit-git "remote" "set-head" "--auto" remote) - (message "Determining old default branch...done") - (magit-git-string "symbolic-ref" "--short" symref))) - (oldname (if oldhead - (cdr (magit-split-branch-name oldhead)) - (error "Cannot determine old default branch"))) - (default (and (not (equal oldname "main")) "main")) - (newname (read-string - (format "Rename default branch `%s' to%s: " - oldname - (if default (format " (default: %s)" default) "")) - nil nil default))) - (message "Renaming default branch...") - (forge--set-default-branch repo newname oldname) - (magit-refresh) - (message "Renaming default branch...done"))) - -;;;###autoload -(defun forge-reset-database () - "Move the current database file to the trash. -This is useful after the database scheme has changed, which will -happen a few times while the forge functionality is still under -heavy development." - (interactive) - (when (and (file-exists-p forge-database-file) - (yes-or-no-p "Really trash Forge's database file? ")) - (when-let ((db (forge-db t))) - (emacsql-close db)) - (delete-file forge-database-file t) - (magit-refresh))) - -(defun forge-enable-sql-logging () - "Enable logging Forge's SQL queries." - (interactive) - (let ((db (forge-db))) - (emacsql-enable-debugging db) - (switch-to-buffer-other-window (emacsql-log-buffer (oref db connection))))) - -(magit-define-section-jumper forge-jump-to-pullreqs "Pull requests" pullreqs) -(magit-define-section-jumper forge-jump-to-issues "Issues" issues) - -;;; _ -(provide 'forge-commands) -;;; forge-commands.el ends here diff --git a/elpa/forge-20230505.926/forge-core.el b/elpa/forge-20230505.926/forge-core.el deleted file mode 100644 index 812c8391..00000000 --- a/elpa/forge-20230505.926/forge-core.el +++ /dev/null @@ -1,370 +0,0 @@ -;;; forge-core.el --- Core functionality -*- lexical-binding:t -*- - -;; Copyright (C) 2018-2023 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 'subr-x) - -(require 'transient) - -(require 'forge-db) - -(eval-when-compile - (cl-pushnew 'id eieio--known-slot-names) - (cl-pushnew 'name eieio--known-slot-names) - (cl-pushnew 'owner eieio--known-slot-names) - (cl-pushnew 'number eieio--known-slot-names)) - -;;; Options - -(defgroup forge nil - "Options concerning Git forges." - :group 'magit) - -(defgroup forge-faces nil - "Faces concerning Git forges." - :group 'forge - :group 'magit-faces) - -(defcustom forge-alist - '(;; Forges - ("github.com" "api.github.com" - "github.com" forge-github-repository) - ("gitlab.com" "gitlab.com/api/v4" - "gitlab.com" forge-gitlab-repository) - ("salsa.debian.org" "salsa.debian.org/api/v4" - "salsa.debian.org" forge-gitlab-repository) - ("framagit.org" "framagit.org/api/v4" - "framagit.org" forge-gitlab-repository) - ("gitlab.gnome.org" "gitlab.gnome.org/api/v4" - "gitlab.gnome.org" forge-gitlab-repository) - ;; Forges (API unsupported) - ("codeberg.org" "codeberg.org/api/v1" - "codeberg.org" forge-gitea-repository) - ("code.orgmode.org" "code.orgmode.org/api/v1" - "code.orgmode.org" forge-gogs-repository) - ("bitbucket.org" "api.bitbucket.org/2.0" - "bitbucket.org" forge-bitbucket-repository) - ;; Semi-Forges - ("git.savannah.gnu.org" nil - "git.savannah.gnu.org" forge-cgit**-repository) - ("git.kernel.org" nil - "git.kernel.org" forge-cgit-repository) - ("repo.or.cz" nil - "repo.or.cz" forge-repoorcz-repository) - ("git.suckless.org" nil - "git.suckless.org" forge-stagit-repository) - ("git.sr.ht" nil - "git.sr.ht" forge-srht-repository)) - "List of Git forges. - -Each entry has the form (GITHOST APIHOST ID CLASS). - -GITHOST is matched against the host part of Git remote urls - using `forge--url-regexp' to identify the forge. -APIHOST is the api endpoint of the forge's api. -ID is used to identify the forge in the local database. -CLASS is the class to be used for repository from the forge. - -GITHOST and APIHOST can be changed, but ID and CLASS are final. -If you change ID, then the identity of every repository from -that forge changes. If you change CLASS, then things start -falling apart. - -There can be multiple elements that only differ in GITHOST. -Among those, the canonical element should come first. Any -elements that have the same APIHOST must also have the same -ID, and vice-versa. - -Complications: - -* When connecting to a Github Enterprise edition whose REST - API's end point is \"/v3\" and whose GraphQL API's - end point is \"/graphql\", then use \"/v3\" as - APIHOST. This is a historic accident. See issue #174. - -* This variable does not account for the possibility that the - git repository does not use the same address as the web - interface. That is another historic accident and if many - users are affected by it, we might have to fix it properly. - If you would like that, comment on issue #532. - - For now a workaround has to be used. Assuming the web - interface is available at \"example.com\" and the repository - is at \"ssh.example.com\", use \"example.com\" as GITHOST and - add something like this to \".gitconfig\": - - [url \"git@ssh.example.com\"] - insteadOf = git@example.com" - :package-version '(forge . "0.1.0") - :group 'forge - :type '(repeat (list (string :tag "Git host") - (choice (string :tag "API endpoint") - (const :tag "No API" nil)) - (string :tag "ID") - (symbol :tag "Repository class")))) - -(defcustom forge-pull-notifications nil - "Whether `forge-pull' also fetches notifications. -If this is nil, then `forge-pull-notifications' has to be used." - :package-version '(forge . "0.2.0") - :group 'forge - :type 'boolean) - -;;; Core - -(defclass forge-object (closql-object) () :abstract t) - -(cl-defgeneric forge-get-parent (object) - "Return the parent object of OBJECT. -The hierarchy is repository > topic > post. -For other objects return nil.") - -(cl-defgeneric forge-get-repository (demand) - "Return a forge repository object or nil, or signal an error. - -The DEMAND argument controls what to do when the object isn't -stored in the database yet, or if it is marked as sparse. The -valid values are: - -* `nil' If the repository is stored in the database then return - it, even if it is sparse. Otherwise return nil. - -* `t' If the repository isn't stored in the database or if the - object is sparse, then signal an error, informing the user - that `this-command' cannot be run until the repository has - been pulled. - -* `full' If the repository is stored in the database and the - object isn't sparse, then return it. Otherwise return nil. - -* `stub' If the repository is stored in the database, then return - it, regardless of whether it is sparse or not. Otherwise create - a new object and return it, but do not store it in the database. - In the latter case it is assumed that the caller does not need - the `id' and `forge-id' slots whose value differ from what they - would be if the object were retrieved from the database. - -* `create' This value is only intended to be used by commands - that fetch data from the API. If the repository is stored in - the database, then return that, regardless of whether the - object is sparse or not. If the repository is not stored in the - database, then make an API request to determine the ID used on - the forge, derive our own ID from that, and store a new sparse - object in the database and return it. - -If DEMAND is t, `stub' or `create', then also signal an error if -the repository cannot be determined because there is no matching -entry in `forge-alist'. - -Also update the object's `apihost', `githost' and `remote' slots -according to the respective entry in `forge-alist' and the REMOTE -argument. - -Also see info node `(forge) Repository Detection'.") - -(cl-defgeneric forge-get-topic () - "Return a forge issue or pullreq object.") - -(cl-defgeneric forge-get-issue () - "Return a forge issue object.") - -(cl-defgeneric forge-get-pullreq () - "Return a forge pullreq object.") - -(cl-defgeneric forge-get-url (obj) - "Return the URL for a forge object.") - -(cl-defgeneric forge-browse (obj) - "Visit the URL corresponding to a forge object in a browser." - (browse-url (forge-get-url obj))) - -(cl-defgeneric forge-visit (obj) - "View a forge object in a separate buffer.") - -(cl-defgeneric forge--object-id (class &rest args) - "Return the database id for the CLASS object specified by ARGS.") - -(cl-defgeneric forge--repository-ids (class host owner name &optional stub) - "Return the database and forge ids for the specified CLASS object.") - -(cl-defmethod magit-section-ident-value ((obj forge-object)) - (oref obj id)) - -;;; Utilities - -(defmacro forge--childp (obj type) - "Somewhat similar to `cl-typep' but only for (possibly unknown) classes. -TYPE is evaluated at macro-expansion time but unlike with -`cl-typep' the respective class does not have to be defined -at that time." - (let ((fn (intern (concat (symbol-name (eval type)) "--eieio-childp")))) - `(and (fboundp ',fn) (,fn ,obj)))) - -(defun forge--set-id-slot (repo object slot rows) - (let ((repo-id (oref repo id))) - (closql-oset - object slot - (mapcar (lambda (val) - (forge--object-id repo-id - (if (atom val) val (alist-get 'id val)))) - rows)))) - -(cl-defgeneric forge--format (object slot &optional spec)) - -(cl-defmethod forge--format ((remote string) slot &optional spec) - (if-let ((parts (forge--split-remote-url remote))) - (forge--format - (forge-get-repository 'stub remote) slot - (pcase-let* ((`(,host ,owner ,name) parts) - (path (if owner (concat owner "/" name) name))) - `(,@spec - (?h . ,host) - (?o . ,owner) - (?n . ,name) - (?p . ,path) - (?P . ,(string-replace "/" "%2F" path))))) - (user-error "Cannot browse non-forge remote %s" remote))) - -(defun forge--url-regexp () - (concat "\\`\\(?:git://\\|" - "[^/@]+@\\|" - "\\(?:ssh\\|ssh\\+git\\|git\\+ssh\\)://\\(?:[^/@]+@\\)?\\|" - "https?://\\(?:[^/@]+@\\)?\\)?" - (regexp-opt (mapcar #'car forge-alist) t) - "\\(?::[0-9]+\\)?" - "\\(?:/\\|:/?\\)" - "\\(.+?\\)" - "\\(?:\\.git\\|/\\)?\\'")) - -(defun forge--split-remote-url (remote) - (and-let* ((url (magit-git-string "remote" "get-url" remote))) - (forge--split-url url))) - -(defun forge--split-url (url) - (and (string-match (forge--url-regexp) url) - (and-let* ((host (match-string 1 url)) - (path (match-string 2 url)) - (path (forge--split-url-path - (nth 3 (assoc host forge-alist)) - path))) - (cons host path)))) - -(cl-defmethod forge--split-url-path - ((_class (subclass forge-repository)) path) - (and (string-match "\\`\\([^/]+\\)/\\([^/]+?\\)\\'" path) - (list (match-string 1 path) - (match-string 2 path)))) - -(cl-defmethod forge--split-url-path - ((_class (subclass forge-noapi-repository)) path) - (and (string-match "\\`\\(?:~?\\(.+\\)/\\)?\\([^/]+?\\)\\'" path) - (list (match-string 1 path) - (match-string 2 path)))) - -(defun forge--url-p (url) - (save-match-data - (and (string-match (forge--url-regexp) url) - (nth 2 (assoc (match-string 1 url) forge-alist))))) - -(defun forge--forge-remote-p (remote) - (and-let* ((url (magit-git-string "remote" "get-url" remote))) - (forge--url-p url))) - -(defun forge--url-equal (urlA urlB) - (or (equal urlA urlB) - (save-match-data - (let ((re (forge--url-regexp)) - hostA repoA hostB repoB) - (and (when (string-match re urlA) - (setq hostA (match-string 1 urlA)) - (setq repoA (match-string 2 urlA))) - (when (string-match re urlB) - (setq hostB (match-string 1 urlB)) - (setq repoB (match-string 2 urlB))) - (equal repoA repoB) - (equal (cl-caddr (assoc hostA forge-alist)) - (cl-caddr (assoc hostB forge-alist)))))))) - -(cl-defmethod forge--format-resource ((object forge-object) resource) - (save-match-data - (setq resource - (replace-regexp-in-string - ":\\([^/]+\\)" - (lambda (str) - (let ((slot (intern (substring str 1)))) - (or (and-let* - ((v (ignore-errors - (cl-case slot - (repo (oref object name)) - (project (concat (string-replace - "/" "%2F" (oref object owner)) - "%2F" - (oref object name))) - (topic (and (forge--childp object 'forge-topic) - (oref object number))) - (t (eieio-oref object slot)))))) - (format "%s" v)) - str))) - resource t t)) - (if (string-match ":[^/]*" resource) - (if-let ((parent (ignore-errors (forge-get-parent object)))) - (forge--format-resource parent resource) - (error "Cannot resolve %s for a %s" - (match-string 0 resource) - (eieio-object-class object))) - resource))) - -;; This is a copy of `org-id-uuid'. -(defun forge--uuid () - "Return string with random (version 4) UUID." - (let ((rnd (md5 (format "%s%s%s%s%s%s%s" - (random) - (current-time) - (user-uid) - (emacs-pid) - (user-full-name) - user-mail-address - (recent-keys))))) - (format "%s-%s-4%s-%s%s-%s" - (substring rnd 0 8) - (substring rnd 8 12) - (substring rnd 13 16) - (format "%x" - (logior - #b10000000 - (logand - #b10111111 - (string-to-number - (substring rnd 16 18) 16)))) - (substring rnd 18 20) - (substring rnd 20 32)))) - -;;; _ -(provide 'forge-core) -;;; forge-core.el ends here diff --git a/elpa/forge-20230505.926/forge-db.el b/elpa/forge-20230505.926/forge-db.el deleted file mode 100644 index 237989c2..00000000 --- a/elpa/forge-20230505.926/forge-db.el +++ /dev/null @@ -1,446 +0,0 @@ -;;; forge-db.el --- Database implementation -*- lexical-binding:t -*- - -;; Copyright (C) 2018-2023 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-get-issue "forge-core") -(declare-function forge-get-pullreq "forge-core") -(declare-function forge--object-id "forge-core") - -(eval-when-compile - (cl-pushnew 'value eieio--known-slot-names)) - -;;; Options - -(defcustom forge-database-file - (expand-file-name "forge-database.sqlite" user-emacs-directory) - "The file used to store the forge database." - :package-version '(forge . "0.1.0") - :group 'forge - :type 'file) - -;;; Core - -(defclass forge-database (closql-database) - ((name :initform "Forge") - (object-class :initform 'forge-repository) - (file :initform 'forge-database-file) - (schemata :initform 'forge--db-table-schemata) - (version :initform 9))) - -(defvar forge--override-connection-class nil) - -(defun forge-db (&optional livep) - (closql-db 'forge-database livep forge--override-connection-class)) - -(defun forge-sql (sql &rest args) - (if (stringp sql) - (emacsql (forge-db) (apply #'format sql args)) - (apply #'emacsql (forge-db) sql args))) - -(defun forge-connect-database-once () - "Try to connect Forge database on first use of `magit-status' only." - (remove-hook 'magit-status-mode-hook #'forge-connect-database-once) - (forge-db)) -(add-hook 'magit-status-mode-hook #'forge-connect-database-once) - -;;; Schemata - -(defconst forge--db-table-schemata - '((repository - [(class :not-null) - (id :not-null :primary-key) - forge-id - forge - owner - name - apihost - githost - remote - sparse-p - created - updated - pushed - parent - description - homepage - default-branch - archived-p - fork-p - locked-p - mirror-p - private-p - issues-p - wiki-p - stars - watchers - (assignees :default eieio-unbound) - (forks :default eieio-unbound) - (issues :default eieio-unbound) - (labels :default eieio-unbound) - (revnotes :default eieio-unbound) - (pullreqs :default eieio-unbound) - selective-p - worktree - (milestones :default eieio-unbound)]) - - (assignee - [(repository :not-null) - (id :not-null :primary-key) - login - name - forge-id] ; Needed for Gitlab. - (:foreign-key - [repository] :references repository [id] - :on-delete :cascade)) - - (fork - [(parent :not-null) - (id :not-null :primary-key) - owner - name] - (:foreign-key - [parent] :references repository [id] - :on-delete :cascade)) - - (issue - [(class :not-null) - (id :not-null :primary-key) - repository - number - state - author - title - created - updated - closed - unread-p - locked-p - milestone - body - (assignees :default eieio-unbound) - (cards :default eieio-unbound) - (edits :default eieio-unbound) - (labels :default eieio-unbound) - (participants :default eieio-unbound) - (posts :default eieio-unbound) - (reactions :default eieio-unbound) - (timeline :default eieio-unbound) - (marks :default eieio-unbound) - note - their-id] - (:foreign-key - [repository] :references repository [id] - :on-delete :cascade)) - - (issue-assignee - [(issue :not-null) - (id :not-null)] - (:foreign-key - [issue] :references issue [id] - :on-delete :cascade)) - - (issue-label - [(issue :not-null) - (id :not-null)] - (:foreign-key - [issue] :references issue [id] - :on-delete :cascade) - (:foreign-key - [id] :references label [id] - :on-delete :cascade)) - - (issue-mark - [(issue :not-null) - (id :not-null)] - (:foreign-key - [issue] :references issue [id] - :on-delete :cascade) - (:foreign-key - [id] :references mark [id] - :on-delete :cascade)) - - (issue-post - [(class :not-null) - (id :not-null :primary-key) - issue - number - author - created - updated - body - (edits :default eieio-unbound) - (reactions :default eieio-unbound)] - (:foreign-key - [issue] :references issue [id] - :on-delete :cascade)) - - (label - [(repository :not-null) - (id :not-null :primary-key) - name - color - description] - (:foreign-key - [repository] :references repository [id] - :on-delete :cascade)) - - (mark - [;; For now this is always nil because it seems more useful to - ;; share marks between repositories. We cannot omit this slot - ;; though because `closql--iref' expects `id' to be the second - ;; slot. - repository - (id :not-null :primary-key) - name - face - description]) - - (milestone - [(repository :not-null) - (id :not-null :primary-key) - number - title - created - updated - due - closed - description] - (:foreign-key - [repository] :references repository [id] - :on-delete :cascade)) - - (notification - [(class :not-null) - (id :not-null :primary-key) - thread-id - repository - forge - reason - unread-p - last-read - updated - title - type - topic - url] - (:foreign-key - [repository] :references repository [id] - :on-delete :cascade)) - - (pullreq - [(class :not-null) - (id :not-null :primary-key) - repository - number - state - author - title - created - updated - closed - merged - unread-p - locked-p - editable-p - cross-repo-p - base-ref - base-repo - head-ref - head-user - head-repo - milestone - body - (assignees :default eieio-unbound) - (cards :default eieio-unbound) - (commits :default eieio-unbound) - (edits :default eieio-unbound) - (labels :default eieio-unbound) - (participants :default eieio-unbound) - (posts :default eieio-unbound) - (reactions :default eieio-unbound) - (review-requests :default eieio-unbound) - (reviews :default eieio-unbound) - (timeline :default eieio-unbound) - (marks :default eieio-unbound) - note - base-rev - head-rev - draft-p - their-id] - (:foreign-key - [repository] :references repository [id] - :on-delete :cascade)) - - (pullreq-assignee - [(pullreq :not-null) - (id :not-null)] - (:foreign-key - [pullreq] :references pullreq [id] - :on-delete :cascade)) - - (pullreq-label - [(pullreq :not-null) - (id :not-null)] - (:foreign-key - [pullreq] :references pullreq [id] - :on-delete :cascade) - (:foreign-key - [id] :references label [id] - :on-delete :cascade)) - - (pullreq-mark - [(pullreq :not-null) - (id :not-null)] - (:foreign-key - [pullreq] :references pullreq [id] - :on-delete :cascade) - (:foreign-key - [id] :references mark [id] - :on-delete :cascade)) - - (pullreq-post - [(class :not-null) - (id :not-null :primary-key) - pullreq - number - author - created - updated - body - (edits :default eieio-unbound) - (reactions :default eieio-unbound)] - (:foreign-key - [pullreq] :references pullreq [id] - :on-delete :cascade)) - - (pullreq-review-request - [(pullreq :not-null) - (id :not-null)] - (:foreign-key - [pullreq] :references pullreq [id] - :on-delete :cascade)) - - (revnote - [(class :not-null) - (id :not-null :primary-key) - repository - commit - file - line - author - body] - (:foreign-key - [repository] :references repository [id] - :on-delete :cascade)))) - -(cl-defmethod closql--db-update-schema ((db forge-database)) - (let ((code-version (oref-default 'forge-database version)) - (version (closql--db-get-version db))) - (when (< version code-version) - (forge--backup-database db)) - (closql-with-transaction db - (when (= version 2) - (message "Upgrading Forge database from version 2 to 3...") - (emacsql db [:create-table pullreq-review-request $S1] - (cdr (assq 'pullreq-review-request forge--db-table-schemata))) - (closql--db-set-version db (setq version 3)) - (message "Upgrading Forge database from version 2 to 3...done")) - (when (= version 3) - (message "Upgrading Forge database from version 3 to 4...") - (emacsql db [:drop-table notification]) - (pcase-dolist (`(,table . ,schema) forge--db-table-schemata) - (when (memq table '(notification - mark issue-mark pullreq-mark)) - (emacsql db [:create-table $i1 $S2] table schema))) - (emacsql db [:alter-table issue :add-column marks :default $s1] 'eieio-unbound) - (emacsql db [:alter-table pullreq :add-column marks :default $s1] 'eieio-unbound) - (closql--db-set-version db (setq version 4)) - (message "Upgrading Forge database from version 3 to 4...done")) - (when (= version 4) - (message "Upgrading Forge database from version 4 to 5...") - (emacsql db [:alter-table repository :add-column selective-p :default nil]) - (closql--db-set-version db (setq version 5)) - (message "Upgrading Forge database from version 4 to 5...done")) - (when (= version 5) - (message "Upgrading Forge database from version 5 to 6...") - (emacsql db [:alter-table repository :add-column worktree :default nil]) - (closql--db-set-version db (setq version 6)) - (message "Upgrading Forge database from version 5 to 6...done")) - (when (= version 6) - (message "Upgrading Forge database from version 6 to 7...") - (emacsql db [:alter-table issue :add-column note :default nil]) - (emacsql db [:alter-table pullreq :add-column note :default nil]) - (emacsql db [:create-table milestone $S1] - (cdr (assq 'milestone forge--db-table-schemata))) - (emacsql db [:alter-table repository :add-column milestones :default $s1] - 'eieio-unbound) - (pcase-dolist (`(,repo-id ,issue-id ,milestone) - (emacsql db [:select [repository id milestone] - :from issue - :where (notnull milestone)])) - (unless (stringp milestone) - (oset (forge-get-issue issue-id) milestone - (forge--object-id repo-id (cdar milestone))))) - (pcase-dolist (`(,repo-id ,pullreq-id ,milestone) - (emacsql db [:select [repository id milestone] - :from pullreq - :where (notnull milestone)])) - (unless (stringp milestone) - (oset (forge-get-pullreq pullreq-id) milestone - (forge--object-id repo-id (cdar milestone))))) - (closql--db-set-version db (setq version 7)) - (message "Upgrading Forge database from version 6 to 7...done")) - (when (= version 7) - (message "Upgrading Forge database from version 7 to 8...") - (emacsql db [:alter-table pullreq :add-column base-rev :default nil]) - (emacsql db [:alter-table pullreq :add-column head-rev :default nil]) - (emacsql db [:alter-table pullreq :add-column draft-p :default nil]) - (closql--db-set-version db (setq version 8)) - (message "Upgrading Forge database from version 7 to 8...done")) - (when (= version 8) - (message "Upgrading Forge database from version 8 to 9...") - (emacsql db [:alter-table pullreq :add-column their-id :default nil]) - (emacsql db [:alter-table issue :add-column their-id :default nil]) - (closql--db-set-version db (setq version 9)) - (message "Upgrading Forge database from version 8 to 9...done"))) - (cl-call-next-method))) - -(defun forge--backup-database (db) - (let ((dst (concat (file-name-sans-extension forge-database-file) - (format "-v%s" (caar (emacsql (oref db connection) - [:pragma user-version]))) - (format-time-string "-%Y%m%d-%H%M") - ".sqlite"))) - (message "Copying Forge database to %s..." dst) - (copy-file forge-database-file dst) - (message "Copying Forge database to %s...done" dst))) - -;;; _ -(provide 'forge-db) -;;; forge-db.el ends here diff --git a/elpa/forge-20230505.926/forge-gitea.el b/elpa/forge-20230505.926/forge-gitea.el deleted file mode 100644 index 31be47f7..00000000 --- a/elpa/forge-20230505.926/forge-gitea.el +++ /dev/null @@ -1,47 +0,0 @@ -;;; forge-gitea.el --- Gitea support -*- lexical-binding:t -*- - -;; Copyright (C) 2018-2023 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-20230505.926/forge-github.el b/elpa/forge-20230505.926/forge-github.el deleted file mode 100644 index 56507517..00000000 --- a/elpa/forge-20230505.926/forge-github.el +++ /dev/null @@ -1,801 +0,0 @@ -;;; forge-github.el --- Github support -*- lexical-binding:t -*- - -;; Copyright (C) 2018-2023 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/*"))) - -;;; Pull -;;;; Repository - -(cl-defmethod forge--pull ((repo forge-github-repository) until - &optional callback) - (let ((buf (current-buffer)) - (dir default-directory) - (selective-p (oref repo selective-p)) - (ghub-graphql-items-per-request - (string-to-number - (or (magit-get "forge.graphqlItemLimit") "100")))) - (ghub-fetch-repository - (oref repo owner) - (oref repo name) - (lambda (data) - (forge--msg repo t t "Pulling REPO") - (forge--msg repo t nil "Storing REPO") - (closql-with-transaction (forge-db) - (let-alist data - (forge--update-repository repo data) - (forge--update-assignees repo .assignableUsers) - (forge--update-forks repo .forks) - (forge--update-labels repo .labels) - (forge--update-milestones repo .milestones) - (forge--update-issues repo .issues t) - (forge--update-pullreqs repo .pullRequests t) - (forge--update-revnotes repo .commitComments)) - (oset repo sparse-p nil)) - (forge--msg repo t t "Storing REPO") - (cond - (selective-p) - (callback (funcall callback)) - (forge-pull-notifications - (forge--pull-notifications (eieio-object-class repo) - (oref repo githost) - (lambda () (forge--git-fetch buf dir repo)))) - (t (forge--git-fetch buf dir repo)))) - `((issues-until . ,(forge--topics-until repo until 'issue)) - (pullRequests-until . ,(forge--topics-until repo until 'pullreq))) - :host (oref repo apihost) - :auth 'forge - :sparse selective-p))) - -(cl-defmethod forge--pull-topic ((repo forge-github-repository) - (topic forge-topic)) - (let ((buffer (current-buffer)) - (fetch #'ghub-fetch-issue) - (update #'forge--update-issue) - (errorback (lambda (err _headers _status _req) - (when (equal (cdr (assq 'type (cadr err))) "NOT_FOUND") - (forge--pull-topic - repo (forge-pullreq :repository (oref repo id) - :number (oref topic number))))))) - (when (cl-typep topic 'forge-pullreq) - (setq fetch #'ghub-fetch-pullreq) - (setq update #'forge--update-pullreq) - (setq errorback nil)) - (funcall - fetch - (oref repo owner) - (oref repo name) - (oref topic number) - (lambda (data) - (funcall update repo data nil) - (with-current-buffer - (if (buffer-live-p buffer) buffer (current-buffer)) - (magit-refresh))) - nil - :errorback errorback - :host (oref repo apihost) - :auth 'forge))) - -(cl-defmethod forge--update-repository ((repo forge-github-repository) data) - (let-alist data - (oset repo created .createdAt) - (oset repo updated .updatedAt) - (oset repo pushed .pushedAt) - (oset repo parent .parent.nameWithOwner) - (oset repo description .description) - (oset repo homepage (and (not (equal .homepageUrl "")) .homepageUrl)) - (oset repo default-branch .defaultBranchRef.name) - (oset repo archived-p .isArchived) - (oset repo fork-p .isFork) - (oset repo locked-p .isLocked) - (oset repo mirror-p .isMirror) - (oset repo private-p .isPrivate) - (oset repo issues-p .hasIssuesEnabled) - (oset repo wiki-p .hasWikiEnabled) - (oset repo stars .stargazers.totalCount) - (oset repo watchers .watchers.totalCount))) - -(cl-defmethod forge--update-issues ((repo forge-github-repository) data bump) - (closql-with-transaction (forge-db) - (mapc (lambda (e) (forge--update-issue repo e bump)) data))) - -(cl-defmethod forge--update-issue ((repo forge-github-repository) data bump) - (closql-with-transaction (forge-db) - (let-alist data - (let* ((issue-id (forge--object-id 'forge-issue repo .number)) - (issue (or (forge-get-issue repo .number) - (closql-insert - (forge-db) - (forge-issue :id issue-id - :repository (oref repo id) - :number .number))))) - (oset issue id issue-id) - (oset issue their-id .id) - (oset issue state (pcase-exhaustive .state - ("CLOSED" 'closed) - ("OPEN" 'open))) - (oset issue author .author.login) - (oset issue title .title) - (oset issue created .createdAt) - (oset issue updated (cond (bump (or .updatedAt .createdAt)) - ((slot-boundp issue 'updated) - (oref issue updated)) - (t "0"))) - (oset issue closed .closedAt) - (oset issue locked-p .locked) - (oset issue milestone (and .milestone.id - (forge--object-id (oref repo id) - .milestone.id))) - (oset issue body (forge--sanitize-string .body)) - .databaseId ; Silence Emacs 25 byte-compiler. - (dolist (c .comments) - (let-alist c - (closql-insert - (forge-db) - (forge-issue-post - :id (forge--object-id issue-id .databaseId) - :issue issue-id - :number .databaseId - :author .author.login - :created .createdAt - :updated .updatedAt - :body (forge--sanitize-string .body)) - t))) - (when bump - (forge--set-id-slot repo issue 'assignees .assignees) - (unless (magit-get-boolean "forge.kludge-for-issue-294") - (forge--set-id-slot repo issue 'labels .labels))) - issue)))) - -(cl-defmethod forge--update-pullreqs ((repo forge-github-repository) data bump) - (closql-with-transaction (forge-db) - (mapc (lambda (e) (forge--update-pullreq repo e bump)) data))) - -(cl-defmethod forge--update-pullreq ((repo forge-github-repository) data bump) - (closql-with-transaction (forge-db) - (let-alist data - (let* ((pullreq-id (forge--object-id 'forge-pullreq repo .number)) - (pullreq (or (forge-get-pullreq repo .number) - (closql-insert - (forge-db) - (forge-pullreq :id pullreq-id - :repository (oref repo id) - :number .number))))) - (oset pullreq their-id .id) - (oset pullreq state (pcase-exhaustive .state - ("MERGED" 'merged) - ("CLOSED" 'closed) - ("OPEN" 'open))) - (oset pullreq author .author.login) - (oset pullreq title .title) - (oset pullreq created .createdAt) - (oset pullreq updated (cond (bump (or .updatedAt .createdAt)) - ((slot-boundp pullreq 'updated) - (oref pullreq updated)) - (t "0"))) - (oset pullreq closed .closedAt) - (oset pullreq merged .mergedAt) - (oset pullreq draft-p .isDraft) - (oset pullreq locked-p .locked) - (oset pullreq editable-p .maintainerCanModify) - (oset pullreq cross-repo-p .isCrossRepository) - (oset pullreq base-ref .baseRef.name) - (oset pullreq base-rev .baseRefOid) - (oset pullreq base-repo .baseRef.repository.nameWithOwner) - (oset pullreq head-ref .headRef.name) - (oset pullreq head-rev .headRefOid) - (oset pullreq head-user .headRef.repository.owner.login) - (oset pullreq head-repo .headRef.repository.nameWithOwner) - (oset pullreq milestone (and .milestone.id - (forge--object-id (oref repo id) - .milestone.id))) - (oset pullreq body (forge--sanitize-string .body)) - .databaseId ; Silence Emacs 25 byte-compiler. - (dolist (p .comments) - (let-alist p - (closql-insert - (forge-db) - (forge-pullreq-post - :id (forge--object-id pullreq-id .databaseId) - :pullreq pullreq-id - :number .databaseId - :author .author.login - :created .createdAt - :updated .updatedAt - :body (forge--sanitize-string .body)) - t))) - (when bump - (forge--set-id-slot repo pullreq 'assignees .assignees) - (forge--set-id-slot repo pullreq 'review-requests - (--map (cdr (cadr (car it))) - .reviewRequests)) - (unless (magit-get-boolean "forge.kludge-for-issue-294") - (forge--set-id-slot repo pullreq 'labels .labels))) - pullreq)))) - -(cl-defmethod forge--update-revnotes ((repo forge-github-repository) data) - (closql-with-transaction (forge-db) - (mapc (apply-partially #'forge--update-revnote repo) data))) - -(cl-defmethod forge--update-revnote ((repo forge-github-repository) data) - (closql-with-transaction (forge-db) - (let-alist data - (closql-insert - (forge-db) - (forge-revnote - :id (forge--object-id 'forge-revnote repo .id) - :repository (oref repo id) - :commit .commit.oid - :file .path - :line .position - :author .author.login - :body .body) - t)))) - -(cl-defmethod forge--update-assignees ((repo forge-github-repository) data) - (oset repo assignees - (with-slots (id) repo - (mapcar (lambda (row) - (let-alist row - (list (forge--object-id id .id) - .login - .name - .id))) - (delete-dups data))))) - -(cl-defmethod forge--update-forks ((repo forge-github-repository) data) - (oset repo forks - (with-slots (id) repo - (mapcar (lambda (row) - (let-alist row - (nconc (forge--repository-ids - (eieio-object-class repo) - (oref repo githost) - .owner.login - .name) - (list .owner.login - .name)))) - (delete-dups data))))) - -(cl-defmethod forge--update-labels ((repo forge-github-repository) data) - (oset repo labels - (with-slots (id) repo - (mapcar (lambda (row) - (let-alist row - (list (forge--object-id id .id) - .name - (concat "#" (downcase .color)) - .description))) - (delete-dups data))))) - -(cl-defmethod forge--update-milestones ((repo forge-github-repository) data) - (oset repo milestones - (with-slots (id) repo - (mapcar (lambda (row) - (let-alist row - (list (forge--object-id id .id) - .number - .title - .createdAt - .updatedAt - .dueOn - .closedAt - .description))) - (delete-dups data))))) - -;;;; Notifications - -(cl-defmethod forge--pull-notifications - ((_class (subclass forge-github-repository)) githost &optional callback) - ;; The GraphQL API doesn't support notifications and also likes to - ;; timeout for handcrafted requests, forcing us to perform a major - ;; rain dance. - (let ((spec (assoc githost forge-alist))) - (unless spec - (error "No entry for %S in forge-alist" githost)) - (forge--msg nil t nil "Pulling notifications") - (pcase-let* - ((`(,_ ,apihost ,forge ,_) spec) - (notifs (-keep (lambda (data) - ;; Github may return notifications for repos - ;; the user no longer has access to. Trying - ;; to retrieve information for such a repo - ;; leads to an error, which we suppress. See #164. - (with-demoted-errors "forge--pull-notifications: %S" - (forge--ghub-massage-notification - data forge githost))) - (forge--ghub-get nil "/notifications" - '((all . t)) - :host apihost :unpaginate t))) - (groups (-partition-all 50 notifs)) - (pages (length groups)) - (page 0) - (result nil)) - (cl-labels - ((cb (&optional data _headers _status _req) - (when data - (setq result (nconc result (cdr data)))) - (if groups - (progn (cl-incf page) - (forge--msg nil t nil - "Pulling notifications (page %s/%s)" - page pages) - (ghub--graphql-vacuum - (cons 'query (-keep #'caddr (pop groups))) - nil #'cb nil :auth 'forge :host apihost)) - (forge--msg nil t t "Pulling notifications") - (forge--msg nil t nil "Storing notifications") - (closql-with-transaction (forge-db) - (forge-sql [:delete-from notification - :where (= forge $s1)] forge) - (pcase-dolist (`(,key ,repo ,query ,obj) notifs) - (closql-insert (forge-db) obj) - (forge--zap-repository-cache (forge-get-repository obj)) - (when query - (oset (funcall (if (eq (oref obj type) 'issue) - #'forge--update-issue - #'forge--update-pullreq) - repo (cdr (cadr (assq key result))) nil) - unread-p (oref obj unread-p))))) - (forge--msg nil t t "Storing notifications") - (when callback - (funcall callback))))) - (cb))))) - -(defun forge--ghub-massage-notification (data forge githost) - (let-alist data - (let* ((type (intern (downcase .subject.type))) - (type (if (eq type 'pullrequest) 'pullreq type))) - (and (memq type '(pullreq issue)) - (let* ((number (and (string-match "[0-9]*\\'" .subject.url) - (string-to-number (match-string 0 .subject.url)))) - (repo (forge-get-repository - (list githost - .repository.owner.login - .repository.name) - nil 'create)) - (repoid (oref repo id)) - (owner (oref repo owner)) - (name (oref repo name)) - (id (forge--object-id repoid (string-to-number .id))) - (alias (intern (concat "_" (string-replace "=" "_" id))))) - (list alias repo - `((,alias repository) - [(name ,name) - (owner ,owner)] - ,@(cddr - (caddr - (ghub--graphql-prepare-query - ghub-fetch-repository - (if (eq type 'issue) - `(repository issues (issue . ,number)) - `(repository pullRequest (pullRequest . ,number))) - )))) - (forge-notification - :id id - :thread-id .id - :repository repoid - :forge forge - :reason (intern (downcase .reason)) - :unread-p .unread - :last-read .last_read_at - :updated .updated_at - :title .subject.title - :type type - :topic number - :url .subject.url))))))) - -(cl-defmethod forge-topic-mark-read ((_ forge-github-repository) topic) - (when (oref topic unread-p) - (oset topic unread-p nil) - (when-let ((notif (forge-get-notification topic))) - (oset topic unread-p nil) - (forge--ghub-patch notif "/notifications/threads/:thread-id")))) - -;;;; Miscellaneous - -(cl-defmethod forge--add-user-repos - ((class (subclass forge-github-repository)) host user) - (forge--fetch-user-repos - class (forge--as-apihost host) user - (apply-partially #'forge--batch-add-callback (forge--as-githost host) user))) - -(cl-defmethod forge--add-organization-repos - ((class (subclass forge-github-repository)) host org) - (forge--fetch-organization-repos - class (forge--as-apihost host) org - (apply-partially #'forge--batch-add-callback (forge--as-githost host) org))) - -(cl-defmethod forge--fetch-user-repos - ((_ (subclass forge-github-repository)) host user callback) - (ghub--graphql-vacuum - '(query (user - [(login $login String!)] - (repositories - [(:edges t) - (ownerAffiliations . (OWNER))] - name))) - `((login . ,user)) - (lambda (d) - (funcall callback - (--map (alist-get 'name it) - (let-alist d .user.repositories)))) - nil :auth 'forge :host host)) - -(cl-defmethod forge--fetch-organization-repos - ((_ (subclass forge-github-repository)) host org callback) - (ghub--graphql-vacuum - '(query (organization - [(login $login String!)] - (repositories [(:edges t)] name))) - `((login . ,org)) - (lambda (d) - (funcall callback - (--map (alist-get 'name it) - (let-alist d .organization.repositories)))) - nil :auth 'forge :host host)) - -(defun forge--batch-add-callback (host owner names) - (let ((repos (cl-mapcan (lambda (name) - (let ((repo (forge-get-repository - (list host owner name) - nil 'create))) - (and (oref repo sparse-p) - (list repo)))) - names)) - cb) - (setq cb (lambda () - (when-let ((repo (pop repos))) - (message "Adding %s..." (oref repo name)) - (forge--pull repo nil cb)))) - (funcall cb))) - -;;; Mutations - -(cl-defmethod forge--create-pullreq-from-issue ((repo forge-github-repository) - (issue forge-issue) - source target) - (pcase-let* ((`(,base-remote . ,base-branch) - (magit-split-branch-name target)) - (`(,head-remote . ,head-branch) - (magit-split-branch-name source)) - (head-repo (forge-get-repository 'stub head-remote))) - (forge--ghub-post repo "/repos/:owner/:repo/pulls" - `((issue . ,(oref issue number)) - (base . ,base-branch) - (head . ,(if (equal head-remote base-remote) - head-branch - (concat (oref head-repo owner) ":" - head-branch))) - (maintainer_can_modify . t)) - :callback (lambda (&rest _) - (closql-delete issue) - (forge-pull)) - :errorback (lambda (&rest _) (forge-pull))))) - -(cl-defmethod forge--submit-create-pullreq ((_ forge-github-repository) repo) - (let-alist (forge--topic-parse-buffer) - (when (and .yaml (local-variable-p 'forge-buffer-draft-p)) - (user-error "Cannot use yaml frontmatter and set `%s' at the same time" - 'forge-buffer-draft-p)) - (pcase-let* ((`(,base-remote . ,base-branch) - (magit-split-branch-name forge--buffer-base-branch)) - (`(,head-remote . ,head-branch) - (magit-split-branch-name forge--buffer-head-branch)) - (head-repo (forge-get-repository 'stub head-remote)) - (url-mime-accept-string - ;; Support draft pull-requests. - "application/vnd.github.shadow-cat-preview+json")) - (forge--ghub-post repo "/repos/:owner/:repo/pulls" - `((title . , .title) - (body . , .body) - (base . ,base-branch) - (head . ,(if (equal head-remote base-remote) - head-branch - (concat (oref head-repo owner) ":" - head-branch))) - (draft . ,(if (local-variable-p 'forge-buffer-draft-p) - forge-buffer-draft-p - .draft)) - (maintainer_can_modify . t)) - :callback (forge--post-submit-callback) - :errorback (forge--post-submit-errorback))))) - -(cl-defmethod forge--submit-create-issue ((_ forge-github-repository) repo) - (let-alist (forge--topic-parse-buffer) - (forge--ghub-post repo "/repos/:owner/:repo/issues" - `((title . , .title) - (body . , .body) - ,@(and .labels (list (cons 'labels .labels))) - ,@(and .assignees (list (cons 'assignees .assignees)))) - :callback (forge--post-submit-callback) - :errorback (forge--post-submit-errorback)))) - -(cl-defmethod forge--submit-create-post ((_ forge-github-repository) topic) - (forge--ghub-post topic "/repos/:owner/:repo/issues/:number/comments" - `((body . ,(string-trim (buffer-string)))) - :callback (forge--post-submit-callback) - :errorback (forge--post-submit-errorback))) - -(cl-defmethod forge--submit-edit-post ((_ forge-github-repository) post) - (forge--ghub-patch post - (cl-typecase post - (forge-pullreq "/repos/:owner/:repo/pulls/:number") - (forge-issue "/repos/:owner/:repo/issues/:number") - (forge-post "/repos/:owner/:repo/issues/comments/:number")) - (if (cl-typep post 'forge-topic) - (let-alist (forge--topic-parse-buffer) - `((title . , .title) - (body . , .body))) - `((body . ,(string-trim (buffer-string))))) - :callback (forge--post-submit-callback) - :errorback (forge--post-submit-errorback))) - -(cl-defmethod forge--set-topic-title - ((_repo forge-github-repository) topic title) - (forge--ghub-patch topic - "/repos/:owner/:repo/issues/:number" - `((title . ,title)) - :callback (forge--set-field-callback))) - -(cl-defmethod forge--set-topic-state - ((_repo forge-github-repository) topic) - (forge--ghub-patch topic - "/repos/:owner/:repo/issues/:number" - `((state . ,(cl-ecase (oref topic state) - (closed "OPEN") - (open "CLOSED")))) - :callback (forge--set-field-callback))) - -(cl-defmethod forge--set-topic-draft - ((_repo forge-github-repository) topic value) - (let ((buffer (current-buffer))) - (ghub-graphql - `(mutation (,(if value - 'convertPullRequestToDraft - 'markPullRequestReadyForReview) - [(input $input ,(if value - 'ConvertPullRequestToDraftInput! - 'MarkPullRequestReadyForReviewInput!))] - (pullRequest isDraft))) - `((input (pullRequestId . ,(oref topic their-id)))) - :host (oref (forge-get-repository topic) apihost) - :auth 'forge - :callback (lambda (data &rest _) - (if (assq 'error data) - (ghub--graphql-pp-response data) - (oset topic draft-p value) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (magit-refresh-buffer)))))))) - -(cl-defmethod forge--set-topic-milestone - ((repo forge-github-repository) topic milestone) - (forge--ghub-patch topic - "/repos/:owner/:repo/issues/:number" - `((milestone - . ,(caar (forge-sql [:select [number] - :from milestone - :where (and (= repository $s1) - (= title $s2))] - (oref repo id) - milestone)))) - :callback (forge--set-field-callback))) - -(cl-defmethod forge--set-topic-labels - ((_repo forge-github-repository) topic labels) - (forge--ghub-put topic "/repos/:owner/:repo/issues/:number/labels" nil - :payload labels - :callback (forge--set-field-callback))) - -(cl-defmethod forge--set-topic-assignees - ((_repo forge-github-repository) topic assignees) - (let ((value (mapcar #'car (closql--iref topic 'assignees)))) - (when-let ((add (cl-set-difference assignees value :test #'equal))) - (forge--ghub-post topic "/repos/:owner/:repo/issues/:number/assignees" - `((assignees . ,add)))) - (when-let ((remove (cl-set-difference value assignees :test #'equal))) - (forge--ghub-delete topic "/repos/:owner/:repo/issues/:number/assignees" - `((assignees . ,remove))))) - (forge-pull)) - -(cl-defmethod forge--set-topic-review-requests - ((_repo forge-github-repository) topic reviewers) - (let ((value (mapcar #'car (closql--iref topic 'review-requests)))) - (when-let ((add (cl-set-difference reviewers value :test #'equal))) - (forge--ghub-post topic - "/repos/:owner/:repo/pulls/:number/requested_reviewers" - `((reviewers . ,add)))) - (when-let ((remove (cl-set-difference value reviewers :test #'equal))) - (forge--ghub-delete topic - "/repos/:owner/:repo/pulls/:number/requested_reviewers" - `((reviewers . ,remove))))) - (forge-pull)) - -(cl-defmethod forge--delete-comment - ((_repo forge-github-repository) post) - (forge--ghub-delete post "/repos/:owner/:repo/issues/comments/:number") - (closql-delete post) - (magit-refresh)) - -(cl-defmethod forge--topic-templates ((repo forge-github-repository) - (_ (subclass forge-issue))) - (and-let* ((files (magit-revision-files (oref repo default-branch)))) - (let ((case-fold-search t)) - (if-let ((file (--first (string-match-p "\ -\\`\\(\\|docs/\\|\\.github/\\)issue_template\\(\\.[a-zA-Z0-9]+\\)?\\'" it) - files))) - (list file) - (setq files - (--filter (string-match-p "\\`\\.github/ISSUE_TEMPLATE/[^/]*" it) - files)) - (if-let ((conf (cl-find-if - (lambda (f) - (equal (file-name-nondirectory f) "config.yml")) - files))) - (nconc (delete conf files) - (list conf)) - files))))) - -(cl-defmethod forge--topic-templates ((repo forge-github-repository) - (_ (subclass forge-pullreq))) - (and-let* ((files (magit-revision-files (oref repo default-branch)))) - (let ((case-fold-search t)) - (if-let ((file (--first (string-match-p "\ -\\`\\(\\|docs/\\|\\.github/\\)pull_request_template\\(\\.[a-zA-Z0-9]+\\)?\\'" it) - files))) - (list file) - ;; Unlike for issues, the web interface does not support - ;; multiple pull-request templates. The API does though, - ;; but due to this limitation I doubt many people use them, - ;; so Forge doesn't support them either. - )))) - -(cl-defmethod forge--set-default-branch ((repo forge-github-repository) - newname oldname) - (forge--ghub-post repo - (format "/repos/:owner/:name/branches/%s/rename" oldname) - `((new_name . ,newname))) - (message "Waiting 5 seconds for GitHub to complete rename...") - (sleep-for 5) - (message "Waiting 5 seconds for GitHub to complete rename...done") - (magit-call-git "fetch" "--prune" (oref repo remote)) - (magit--set-default-branch newname oldname)) - -(cl-defmethod forge--fork-repository ((repo forge-github-repository) fork) - (with-slots (owner name) repo - (forge--ghub-post repo - (format "/repos/%s/%s/forks" owner name) - (and (not (equal fork (ghub--username (ghub--host nil)))) - `((organization . ,fork)))) - (ghub-wait (format "/repos/%s/%s" fork name) nil :auth 'forge))) - -(cl-defmethod forge--merge-pullreq ((_repo forge-github-repository) - topic hash method) - (forge--ghub-put topic - "/repos/:owner/:repo/pulls/:number/merge" - `((merge_method . ,(symbol-name method)) - ,@(and hash `((sha . ,hash)))))) - -;;; Utilities - -(cl-defun forge--ghub-get (obj resource - &optional params - &key query payload headers - silent unpaginate noerror reader - host - callback errorback) - (declare (indent defun)) - (ghub-get (if obj (forge--format-resource obj resource) resource) - params - :host (or host (oref (forge-get-repository obj) apihost)) - :auth 'forge - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :callback callback :errorback errorback)) - -(cl-defun forge--ghub-put (obj resource - &optional params - &key query payload headers - silent unpaginate noerror reader - host - callback errorback) - (declare (indent defun)) - (ghub-put (if obj (forge--format-resource obj resource) resource) - params - :host (or host (oref (forge-get-repository obj) apihost)) - :auth 'forge - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :callback callback :errorback errorback)) - -(cl-defun forge--ghub-post (obj resource - &optional params - &key query payload headers - silent unpaginate noerror reader - host callback errorback) - (declare (indent defun)) - (ghub-post (forge--format-resource obj resource) - params - :host (or host (oref (forge-get-repository obj) apihost)) - :auth 'forge - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :callback callback :errorback errorback)) - -(cl-defun forge--ghub-patch (obj resource - &optional params - &key query payload headers - silent unpaginate noerror reader - host callback errorback) - (declare (indent defun)) - (ghub-patch (forge--format-resource obj resource) - params - :host (or host (oref (forge-get-repository obj) apihost)) - :auth 'forge - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :callback callback :errorback errorback)) - -(cl-defun forge--ghub-delete (obj resource - &optional params - &key query payload headers - silent unpaginate noerror reader - host callback errorback) - (declare (indent defun)) - (ghub-delete (forge--format-resource obj resource) - params - :host (or host (oref (forge-get-repository obj) apihost)) - :auth 'forge - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :callback callback :errorback errorback)) - -;;; _ -(provide 'forge-github) -;;; forge-github.el ends here diff --git a/elpa/forge-20230505.926/forge-gitlab.el b/elpa/forge-20230505.926/forge-gitlab.el deleted file mode 100644 index a318bbba..00000000 --- a/elpa/forge-20230505.926/forge-gitlab.el +++ /dev/null @@ -1,672 +0,0 @@ -;;; forge-gitlab.el --- Gitlab support -*- lexical-binding:t -*- - -;; Copyright (C) 2018-2023 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) until) - (let ((cb (let ((buf (and (derived-mode-p 'magit-mode) - (current-buffer))) - (dir default-directory) - (val nil)) - (lambda (cb &optional v) - (when v (if val (push v val) (setq val v))) - (let-alist val - (cond - ((not val) - (forge--fetch-repository repo cb)) - ((not (assq 'assignees val)) - (forge--fetch-assignees repo cb)) - ((not (assq 'forks val)) - (forge--fetch-forks repo cb)) - ((not (assq 'labels val)) - (forge--fetch-labels repo cb)) - ((and .issues_enabled - (not (assq 'issues val))) - (forge--fetch-issues repo cb until)) - ((and .merge_requests_enabled - (not (assq 'pullreqs val))) - (forge--fetch-pullreqs repo cb until)) - (t - (forge--msg repo t t "Pulling REPO") - (forge--msg repo t nil "Storing REPO") - (closql-with-transaction (forge-db) - (forge--update-repository repo val) - (forge--update-assignees repo .assignees) - (forge--update-labels repo .labels) - (dolist (v .issues) (forge--update-issue repo v)) - (dolist (v .pullreqs) (forge--update-pullreq repo v)) - (oset repo sparse-p nil)) - (forge--msg repo t t "Storing REPO") - (unless (oref repo selective-p) - (forge--git-fetch buf dir repo))))))))) - (funcall cb cb))) - -(cl-defmethod forge--fetch-repository ((repo forge-gitlab-repository) callback) - (forge--glab-get repo "/projects/:project" nil - :callback (lambda (value _headers _status _req) - (cond ((oref repo selective-p) - (setq value (append '((assignees) (forks) (labels) - (issues) (pullreqs)) - value))) - ((magit-get-boolean "forge.omitExpensive") - (setq value (append '((assignees) (forks) (labels)) - value)))) - (funcall callback callback value)))) - -(cl-defmethod forge--update-repository ((repo forge-gitlab-repository) data) - (let-alist data - (oset repo created .created_at) - (oset repo updated .last_activity_at) - (oset repo pushed nil) - (oset repo parent .forked_from_project.path_with_namespace) - (oset repo description .description) - (oset repo homepage nil) - (oset repo default-branch .default_branch) - (oset repo archived-p .archived) - (oset repo fork-p (and .forked_from_project.path_with_namespace t)) - (oset repo locked-p nil) - (oset repo mirror-p .mirror) - (oset repo private-p (equal .visibility "private")) - (oset repo issues-p .issues_enabled) - (oset repo wiki-p .wiki_enabled) - (oset repo stars .star_count) - (oset repo watchers .star_count))) - -(cl-defmethod forge--split-url-path - ((_class (subclass forge-gitlab-repository)) path) - (and (string-match "\\`\\(?:~?\\(.+\\)/\\)?\\([^/]+?\\)\\'" path) - (list (match-string 1 path) - (match-string 2 path)))) - -;;;; Issues - -(cl-defmethod forge--fetch-issues ((repo forge-gitlab-repository) callback until) - (let ((cb (let (val cur cnt pos) - (lambda (cb &optional v) - (cond - ((not pos) - (if (setq cur (setq val v)) - (progn - (setq pos 1) - (setq cnt (length val)) - (forge--msg nil nil nil "Pulling issue %s/%s" pos cnt) - (forge--fetch-issue-posts repo cur cb)) - (forge--msg repo t t "Pulling REPO issues") - (funcall callback callback (cons 'issues val)))) - (t - (if (setq cur (cdr cur)) - (progn - (cl-incf pos) - (forge--msg nil nil nil "Pulling issue %s/%s" pos cnt) - (forge--fetch-issue-posts repo cur cb)) - (forge--msg repo t t "Pulling REPO issues") - (funcall callback callback (cons 'issues val))))))))) - (forge--msg repo t nil "Pulling REPO issues") - (forge--glab-get repo "/projects/:project/issues" - `((per_page . 100) - (order_by . "updated_at") - ,@(and-let* ((after (forge--topics-until repo until 'issue))) - `((updated_after . ,after)))) - :unpaginate t - :callback (lambda (value _headers _status _req) - (funcall cb cb value))))) - -(cl-defmethod forge--fetch-issue-posts ((repo forge-gitlab-repository) cur cb) - (let-alist (car cur) - (forge--glab-get repo - (format "/projects/%s/issues/%s/notes" .project_id .iid) - '((per_page . 100)) - :unpaginate t - :callback (lambda (value _headers _status _req) - (setf (alist-get 'notes (car cur)) value) - (funcall cb cb))))) - -(cl-defmethod forge--update-issue ((repo forge-gitlab-repository) data) - (closql-with-transaction (forge-db) - (let-alist data - (let* ((issue-id (forge--object-id 'forge-issue repo .iid)) - (issue - (forge-issue - :id issue-id - :their-id .iid - :number .iid - :repository (oref repo id) - :state (pcase-exhaustive .state - ("closed" 'closed) - ("opened" 'open)) - :author .author.username - :title .title - :created .created_at - :updated .updated_at - ;; `.closed_at' may be nil even though the issues is - ;; closed. In such cases use 1, so that this slots - ;; at least can serve as a boolean. - :closed (or .closed_at (and (equal .state "closed") 1)) - :locked-p .discussion_locked - :milestone .milestone.iid - :body (forge--sanitize-string .description)))) - (closql-insert (forge-db) issue t) - (unless (magit-get-boolean "forge.omitExpensive") - (forge--set-id-slot repo issue 'assignees .assignees) - (forge--set-id-slot repo issue 'labels .labels)) - .body .id ; Silence Emacs 25 byte-compiler. - (dolist (c .notes) - (let-alist c - (let ((post - (forge-issue-post - :id (forge--object-id issue-id .id) - :issue issue-id - :number .id - :author .author.username - :created .created_at - :updated .updated_at - :body (forge--sanitize-string .body)))) - (closql-insert (forge-db) post t)))))))) - -;;;; Pullreqs - -(cl-defmethod forge--fetch-pullreqs ((repo forge-gitlab-repository) callback until) - (let ((cb (let (val cur cnt pos) - (lambda (cb &optional v) - (cond - ((not pos) - (if (setq cur (setq val v)) - (progn - (setq pos 1) - (setq cnt (length val)) - (forge--msg nil nil nil "Pulling pullreq %s/%s" pos cnt) - (forge--fetch-pullreq-posts repo cur cb)) - (forge--msg repo t t "Pulling REPO pullreqs") - (funcall callback callback (cons 'pullreqs val)))) - ((not (assq 'source_project (car cur))) - (forge--fetch-pullreq-source-repo repo cur cb)) - ((not (assq 'target_project (car cur))) - (forge--fetch-pullreq-target-repo repo cur cb)) - (t - (if (setq cur (cdr cur)) - (progn - (cl-incf pos) - (forge--msg nil nil nil "Pulling pullreq %s/%s" pos cnt) - (forge--fetch-pullreq-posts repo cur cb)) - (forge--msg repo t t "Pulling REPO pullreqs") - (funcall callback callback (cons 'pullreqs val))))))))) - (forge--msg repo t nil "Pulling REPO pullreqs") - (forge--glab-get repo "/projects/:project/merge_requests" - `((per_page . 100) - (order_by . "updated_at") - ,@(and-let* ((after (forge--topics-until repo until 'pullreq))) - `((updated_after . ,after)))) - :unpaginate t - :callback (lambda (value _headers _status _req) - (funcall cb cb value))))) - -(cl-defmethod forge--fetch-pullreq-posts - ((repo forge-gitlab-repository) cur cb) - (let-alist (car cur) - (forge--glab-get repo - (format "/projects/%s/merge_requests/%s/notes" .target_project_id .iid) - '((per_page . 100)) - :unpaginate t - :callback (lambda (value _headers _status _req) - (setf (alist-get 'notes (car cur)) value) - (funcall cb cb))))) - -(cl-defmethod forge--fetch-pullreq-source-repo - ((repo forge-gitlab-repository) cur cb) - ;; If the fork no longer exists, then `.source_project_id' is nil. - ;; This will lead to difficulties later on but there is nothing we - ;; can do about it. - (let-alist (car cur) - (if .source_project_id - (forge--glab-get repo (format "/projects/%s" .source_project_id) nil - :errorback (lambda (_err _headers _status _req) - (setf (alist-get 'source_project (car cur)) nil) - (funcall cb cb)) - :callback (lambda (value _headers _status _req) - (setf (alist-get 'source_project (car cur)) value) - (funcall cb cb))) - (setf (alist-get 'source_project (car cur)) nil) - (funcall cb cb)))) - -(cl-defmethod forge--fetch-pullreq-target-repo - ((repo forge-gitlab-repository) cur cb) - (let-alist (car cur) - (forge--glab-get repo (format "/projects/%s" .target_project_id) nil - :errorback (lambda (_err _headers _status _req) - (setf (alist-get 'target_project (car cur)) nil) - (funcall cb cb)) - :callback (lambda (value _headers _status _req) - (setf (alist-get 'target_project (car cur)) value) - (funcall cb cb))))) - -(cl-defmethod forge--update-pullreq ((repo forge-gitlab-repository) data) - (closql-with-transaction (forge-db) - (let-alist data - (let* ((pullreq-id (forge--object-id 'forge-pullreq repo .iid)) - (pullreq - (forge-pullreq - :id pullreq-id - :their-id .iid - :number .iid - :repository (oref repo id) - :state (pcase-exhaustive .state - ("merged" 'merged) - ("closed" 'closed) - ("opened" 'open)) - :author .author.username - :title .title - :created .created_at - :updated .updated_at - ;; `.merged_at' and `.closed_at' may both be nil even - ;; though the pullreq is merged or otherwise closed. - ;; In such cases use 1, so that these slots at least - ;; can serve as booleans. - :closed (or .closed_at - (and (member .state '("closed" "merged")) 1)) - :merged (or .merged_at - (and (equal .state "merged") 1)) - :draft-p .draft - :locked-p .discussion_locked - :editable-p .allow_maintainer_to_push - :cross-repo-p (not (equal .source_project_id - .target_project_id)) - :base-ref .target_branch - :base-rev .diff_refs.start_sha - :base-repo .target_project.path_with_namespace - :head-ref .source_branch - :head-rev .diff_refs.head_sha - :head-user .source_project.owner.username - :head-repo .source_project.path_with_namespace - :milestone .milestone.iid - :body (forge--sanitize-string .description)))) - (closql-insert (forge-db) pullreq t) - (unless (magit-get-boolean "forge.omitExpensive") - (forge--set-id-slot repo pullreq 'assignees .assignees) - (forge--set-id-slot repo pullreq 'review-requests .reviewers) - (forge--set-id-slot repo pullreq 'labels .labels)) - .body .id ; Silence Emacs 25 byte-compiler. - (dolist (c .notes) - (let-alist c - (let ((post - (forge-pullreq-post - :id (forge--object-id pullreq-id .id) - :pullreq pullreq-id - :number .id - :author .author.username - :created .created_at - :updated .updated_at - :body (forge--sanitize-string .body)))) - (closql-insert (forge-db) post t)))))))) - -;;;; Other - -;; The extend of the documentation for "GET /projects/:id/users" is -;; "Get the users list of a project." I don't know what that means, -;; but it stands to reason that this must at least overlap with the -;; set of users that can be assigned to topics. - -(cl-defmethod forge--fetch-assignees ((repo forge-gitlab-repository) callback) - (forge--glab-get repo "/projects/:project/users" - '((per_page . 100)) - :unpaginate t - :callback (lambda (value _headers _status _req) - (funcall callback callback (cons 'assignees value))))) - -(cl-defmethod forge--update-assignees ((repo forge-gitlab-repository) data) - (oset repo assignees - (with-slots (id) repo - (mapcar (lambda (row) - (let-alist row - ;; For other forges we don't need to store `id' - ;; but here we do because that's what has to be - ;; used when assigning issues. - (list (forge--object-id id .id) - .username - .name - .id))) - data)))) - -(cl-defmethod forge--fetch-forks ((repo forge-gitlab-repository) callback) - (forge--glab-get repo "/projects/:project/forks" - '((per_page . 100) - (simple . t)) - :unpaginate t - :callback (lambda (value _headers _status _req) - (funcall callback callback (cons 'forks value))))) - -(cl-defmethod forge--update-forks ((repo forge-gitlab-repository) data) - (oset repo forks - (with-slots (id) repo - (mapcar (lambda (row) - (let-alist row - (nconc (forge--repository-ids - (eieio-object-class repo) - (oref repo githost) - .namespace.path - .path) - (list .namespace.path - .path)))) - data)))) - -(cl-defmethod forge--fetch-labels ((repo forge-gitlab-repository) callback) - (forge--glab-get repo "/projects/:project/labels" - '((per_page . 100)) - :unpaginate t - :callback (lambda (value _headers _status _req) - (funcall callback callback (cons 'labels value))))) - -(cl-defmethod forge--update-labels ((repo forge-gitlab-repository) data) - (oset repo labels - (with-slots (id) repo - (mapcar (lambda (row) - (let-alist row - ;; We should use the label's `id' instead of its - ;; `name' but a topic's `labels' field is a list - ;; of names instead of a list of ids or an alist. - ;; As a result of this we cannot recognize when - ;; a label is renamed and a topic continues to be - ;; tagged with the old label name until it itself - ;; is modified somehow. Additionally it leads to - ;; name conflicts between group and project - ;; labels. See #160. - (list (forge--object-id id .name) - .name - (downcase .color) - .description))) - ;; For now simply remove one of the duplicates. - (cl-delete-duplicates data - :key (apply-partially #'alist-get 'name) - :test #'equal))))) - -;;;; Notifications - -;; The closest to notifications that Gitlab provides are "events" as -;; described at https://docs.gitlab.com/ee/api/events.html. This -;; allows us to see the last events that took place, but that is not -;; good enough because we are mostly interested in events we haven't -;; looked at yet. Gitlab doesn't make a distinction between unread -;; and read events, so this is rather useless and we don't use it for -;; the time being. - -;;; Mutations - -(cl-defmethod forge--submit-create-pullreq ((_ forge-gitlab-repository) base-repo) - (let-alist (forge--topic-parse-buffer) - (pcase-let* ((`(,base-remote . ,base-branch) - (magit-split-branch-name forge--buffer-base-branch)) - (`(,head-remote . ,head-branch) - (magit-split-branch-name forge--buffer-head-branch)) - (head-repo (forge-get-repository 'stub head-remote))) - (forge--glab-post head-repo "/projects/:project/merge_requests" - `((title . ,(if (if (local-variable-p 'forge-buffer-draft-p) - forge-buffer-draft-p - .draft) - (concat "Draft: " .title) - .title)) - (description . , .body) - ,@(and (not (equal head-remote base-remote)) - `((target_project_id . ,(oref base-repo forge-id)))) - (target_branch . ,base-branch) - (source_branch . ,head-branch) - (allow_collaboration . t)) - :callback (forge--post-submit-callback) - :errorback (forge--post-submit-errorback))))) - -(cl-defmethod forge--submit-create-issue ((_ forge-gitlab-repository) repo) - (let-alist (forge--topic-parse-buffer) - (forge--glab-post repo "/projects/:project/issues" - `((title . , .title) - (description . , .body)) - :callback (forge--post-submit-callback) - :errorback (forge--post-submit-errorback)))) - -(cl-defmethod forge--submit-create-post ((_ forge-gitlab-repository) topic) - (forge--glab-post topic - (if (forge-issue-p topic) - "/projects/:project/issues/:number/notes" - "/projects/:project/merge_requests/:number/notes") - `((body . ,(string-trim (buffer-string)))) - :callback (forge--post-submit-callback) - :errorback (forge--post-submit-errorback))) - -(cl-defmethod forge--submit-edit-post ((_ forge-gitlab-repository) post) - (forge--glab-put post - (cl-etypecase post - (forge-pullreq "/projects/:project/merge_requests/:number") - (forge-issue "/projects/:project/issues/:number") - (forge-issue-post "/projects/:project/issues/:topic/notes/:number") - (forge-pullreq-post "/projects/:project/merge_requests/:topic/notes/:number")) - (if (cl-typep post 'forge-topic) - (let-alist (forge--topic-parse-buffer) - ;; Keep Gitlab from claiming that the user - ;; changed the description when that isn't - ;; true. The same isn't necessary for the - ;; title; in that case Gitlab performs the - ;; necessary check itself. - `((title . , .title) - ,@(and (not (equal .body (oref post body))) - `((description . , .body))))) - `((body . ,(string-trim (buffer-string))))) - :callback (forge--post-submit-callback) - :errorback (forge--post-submit-errorback))) - -(cl-defmethod forge--set-topic-field - ((_repo forge-gitlab-repository) topic field value) - (forge--glab-put topic - (cl-typecase topic - (forge-pullreq "/projects/:project/merge_requests/:number") - (forge-issue "/projects/:project/issues/:number")) - `((,field . ,value)) - :callback (forge--set-field-callback))) - -(cl-defmethod forge--set-topic-title - ((repo forge-gitlab-repository) topic title) - (forge--set-topic-field repo topic 'title title)) - -(cl-defmethod forge--set-topic-state - ((repo forge-gitlab-repository) topic) - (forge--set-topic-field repo topic 'state_event - (cl-ecase (oref topic state) - (closed "reopen") - (open "close")))) - -(cl-defmethod forge--set-topic-draft - ((repo forge-gitlab-repository) topic value) - (let ((buffer (current-buffer))) - (glab-graphql - `(mutation (mergeRequestSetDraft - [(input $input MergeRequestSetDraftInput!)] - (mergeRequest iid draft))) - `((input (projectPath . ,(format "%s/%s" - (oref repo owner) - (oref repo name))) - (iid . ,(number-to-string (oref topic number))) - (draft . ,value))) - :host (oref (forge-get-repository topic) apihost) - :auth 'forge - :callback (lambda (data &rest _) - (if (assq 'error data) - (ghub--graphql-pp-response data) - (oset topic draft-p value) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (magit-refresh-buffer)))))))) - -(cl-defmethod forge--set-topic-labels - ((repo forge-gitlab-repository) topic labels) - (forge--set-topic-field repo topic 'labels - (mapconcat #'identity labels ","))) - -(cl-defmethod forge--set-topic-assignees - ((repo forge-gitlab-repository) topic assignees) - (let ((users (mapcar #'cdr (oref repo assignees)))) - (cl-typecase topic - (forge-pullreq ; Can only be assigned to a single user. - (forge--set-topic-field repo topic 'assignee_id - (or (caddr (assoc (car assignees) users)) - 0))) - (forge-issue - (forge--set-topic-field repo topic 'assignee_ids - (or (--map (caddr (assoc it users)) assignees) - 0)))))) - -(cl-defmethod forge--set-topic-review-requests - ((repo forge-gitlab-repository) topic reviewers) - (let ((users (mapcar #'cdr (oref repo assignees)))) - (forge--set-topic-field repo topic 'reviewer_ids - (or (--map (caddr (assoc it users)) reviewers) - 0)))) - -(cl-defmethod forge--delete-comment - ((_repo forge-gitlab-repository) post) - (forge--glab-delete post - (cl-etypecase post - (forge-pullreq-post - "/projects/:project/merge_requests/:topic/notes/:number") - (forge-issue-post - "/projects/:project/issues/:topic/notes/:number"))) - (closql-delete post) - (magit-refresh)) - -(cl-defmethod forge--topic-templates ((repo forge-gitlab-repository) - (_ (subclass forge-issue))) - (--filter (string-match-p "\\`\\.gitlab/issue_templates/.+\\.md\\'" it) - (magit-revision-files (oref repo default-branch)))) - -(cl-defmethod forge--topic-templates ((repo forge-gitlab-repository) - (_ (subclass forge-pullreq))) - (--filter (string-match-p "\\`\\.gitlab/merge_request_templates/.+\\.md\\'" it) - (magit-revision-files (oref repo default-branch)))) - -(cl-defmethod forge--fork-repository ((repo forge-gitlab-repository) fork) - (with-slots (owner name) repo - (forge--glab-post repo (format "/projects/%s%%2F%s/fork" owner name) - (and (not (equal fork (ghub--username (ghub--host nil)))) - `((namespace . ,fork))) - :noerror t) - (ghub-wait (format "/projects/%s%%2F%s" fork name) - nil :auth 'forge :forge 'gitlab))) - -(cl-defmethod forge--merge-pullreq ((_repo forge-gitlab-repository) - topic hash method) - (forge--glab-put topic - "/projects/:project/merge_requests/:number/merge" - `((squash . ,(eq method 'squash)) - ,@(and hash `((sha . ,hash)))))) - -;;; Utilities - -(cl-defmethod forge--topic-type-prefix ((_repo forge-gitlab-repository) type) - (if (eq type 'pullreq) "!" "#")) - -(cl-defun forge--glab-get (obj resource - &optional params - &key query payload headers - silent unpaginate noerror reader - host callback errorback) - (declare (indent defun)) - (glab-get (if obj (forge--format-resource obj resource) resource) - params - :host (or host (oref (forge-get-repository obj) apihost)) - :auth 'forge - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :callback callback - :errorback (or errorback (and callback t)))) - -(cl-defun forge--glab-put (obj resource - &optional params - &key query payload headers - silent unpaginate noerror reader - host callback errorback) - (declare (indent defun)) - (glab-put (if obj (forge--format-resource obj resource) resource) - params - :host (or host (oref (forge-get-repository obj) apihost)) - :auth 'forge - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :callback callback - :errorback (or errorback (and callback t)))) - -(cl-defun forge--glab-post (obj resource - &optional params - &key query payload headers - silent unpaginate noerror reader - host callback errorback) - (declare (indent defun)) - (glab-post (forge--format-resource obj resource) - params - :host (or host (oref (forge-get-repository obj) apihost)) - :auth 'forge - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :callback callback - :errorback (or errorback (and callback t)))) - -(cl-defun forge--glab-delete (obj resource - &optional params - &key query payload headers - silent unpaginate noerror reader - host callback errorback) - (declare (indent defun)) - (glab-delete (forge--format-resource obj resource) - params - :host (or host (oref (forge-get-repository obj) apihost)) - :auth 'forge - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :callback callback - :errorback (or errorback (and callback t)))) - -;;; _ -(provide 'forge-gitlab) -;;; forge-gitlab.el ends here diff --git a/elpa/forge-20230505.926/forge-gogs.el b/elpa/forge-20230505.926/forge-gogs.el deleted file mode 100644 index a13aa8ac..00000000 --- a/elpa/forge-20230505.926/forge-gogs.el +++ /dev/null @@ -1,46 +0,0 @@ -;;; forge-gogs.el --- Gogs support -*- lexical-binding:t -*- - -;; Copyright (C) 2018-2023 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-20230505.926/forge-issue.el b/elpa/forge-20230505.926/forge-issue.el deleted file mode 100644 index 1142e56d..00000000 --- a/elpa/forge-20230505.926/forge-issue.el +++ /dev/null @@ -1,225 +0,0 @@ -;;; forge-issue.el --- Issue support -*- lexical-binding:t -*- - -;; Copyright (C) 2018-2023 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) - (closed :initarg :closed) - (unread-p :initarg :unread-p :initform nil) - (locked-p :initarg :locked-p) - (milestone :initarg :milestone) - (body :initarg :body) - (assignees :closql-table (issue-assignee assignee)) - (project-cards) ; projectsCards - (edits) ; userContentEdits - (labels :closql-table (issue-label label)) - (participants) - (posts :closql-class forge-issue-post) - (reactions) - (timeline) - (marks :closql-table (issue-mark mark)) - (note :initarg :note :initform nil) - (their-id :initarg :their-id) - )) - -(defclass forge-issue-post (forge-post) - ((closql-table :initform 'issue-post) - (closql-primary-key :initform 'id) - (closql-order-by :initform [(asc number)]) - (closql-foreign-key :initform 'issue) - (closql-class-prefix :initform "forge-issue-") - (id :initarg :id) - (issue :initarg :issue) - (number :initarg :number) - (author :initarg :author) - (created :initarg :created) - (updated :initarg :updated) - (body :initarg :body) - (edits) - (reactions) - )) - -;;; Query - -(cl-defmethod forge-get-repository ((post forge-issue-post)) - (forge-get-repository (forge-get-issue post))) - -(cl-defmethod forge-get-topic ((post forge-issue-post)) - (forge-get-issue post)) - -(cl-defmethod forge-get-issue ((issue forge-issue)) - issue) - -(cl-defmethod forge-get-issue ((repo forge-repository) number) - (closql-get (forge-db) - (forge--object-id 'forge-issue repo number) - 'forge-issue)) - -(cl-defmethod forge-get-issue ((number integer)) - (and-let* ((repo (forge-get-repository t))) - (forge-get-issue repo number))) - -(cl-defmethod forge-get-issue ((id string)) - (closql-get (forge-db) id 'forge-issue)) - -(cl-defmethod forge-get-issue ((post forge-issue-post)) - (closql-get (forge-db) - (oref post issue) - 'forge-issue)) - -(cl-defmethod forge-ls-issues ((repo forge-repository) &optional type select) - (forge-ls-topics repo 'forge-issue type select)) - -;;; Utilities - -(defun forge-read-issue (prompt &optional type) - (when (eq type t) - (setq type (if current-prefix-arg nil 'open))) - (let* ((default (forge-current-issue)) - (repo (forge-get-repository (or default t))) - (choices (mapcar - (apply-partially #'forge--topic-format-choice repo) - (forge-ls-issues repo type [number title id class])))) - (cdr (assoc (magit-completing-read - prompt choices nil nil nil nil - (and default - (setq default (forge--topic-format-choice default)) - (member default choices) - (car default))) - choices)))) - -(cl-defmethod forge-get-url ((issue forge-issue)) - (forge--format issue 'issue-url-format)) - -(defun forge--issue-by-forge-short-link-at-point () - (forge--topic-by-forge-short-link-at-point '("#") #'forge-get-issue)) - -;;; Sections - -(defun forge-current-issue () - (or (forge-issue-at-point) - (and (derived-mode-p 'forge-topic-mode) - (forge-issue-p forge-buffer-topic) - forge-buffer-topic) - (and (derived-mode-p 'forge-topic-list-mode) - (let ((topic (forge-get-topic (tabulated-list-get-id)))) - (and (forge-issue-p topic) - topic))))) - -(defun forge-issue-at-point () - (or (magit-section-value-if 'issue) - (and-let* ((post (magit-section-value-if 'post))) - (cond ((forge-issue-p post) - post) - ((forge-issue-post-p post) - (forge-get-issue post)))) - (forge--issue-by-forge-short-link-at-point))) - -(defvar-keymap forge-issues-section-map - " " #'forge-browse-issues - " " #'forge-list-issues - "C-c C-n" #'forge-create-issue) - -(defvar-keymap forge-issue-section-map - " " #'forge-browse-issue - " " #'forge-visit-issue) - -(defun forge-insert-issues () - "Insert a list of mostly recent and/or open issues. -Also see option `forge-topic-list-limit'." - (when (and forge-display-in-status-buffer (forge-db t)) - (when-let ((repo (forge-get-repository nil))) - (when (and (not (oref repo sparse-p)) - (or (not (slot-boundp repo 'issues-p)) ; temporary KLUDGE - (oref repo issues-p))) - (forge-insert-topics "Issues" - (forge-ls-recent-topics repo 'issue) - (forge--topic-type-prefix repo 'issue)))))) - -(defun forge-insert-assigned-issues () - "Insert a list of open issues that are assigned to you." - (when forge-display-in-status-buffer - (when-let ((repo (forge-get-repository nil))) - (unless (oref repo sparse-p) - (forge-insert-topics "Assigned issues" - (forge--ls-assigned-issues repo) - (forge--topic-type-prefix repo 'issue)))))) - -(defun forge--ls-assigned-issues (repo) - (mapcar (lambda (row) - (closql--remake-instance 'forge-issue (forge-db) row)) - (forge-sql - [:select $i1 :from [issue issue_assignee assignee] - :where (and (= issue_assignee:issue issue:id) - (= issue_assignee:id assignee:id) - (= issue:repository $s2) - (= assignee:login $s3) - (isnull issue:closed)) - :order-by [(desc updated)]] - (vconcat (closql--table-columns (forge-db) 'issue t)) - (oref repo id) - (ghub--username repo)))) - -(defun forge-insert-authored-issues () - "Insert a list of open issues that are authored to you." - (when forge-display-in-status-buffer - (when-let ((repo (forge-get-repository nil))) - (unless (oref repo sparse-p) - (forge-insert-topics "Authored issues" - (forge--ls-authored-issues repo) - (forge--topic-type-prefix repo 'issue)))))) - -(defun forge--ls-authored-issues (repo) - (mapcar (lambda (row) - (closql--remake-instance 'forge-issue (forge-db) row)) - (forge-sql - [:select $i1 :from [issue] - :where (and (= issue:repository $s2) - (= issue:author $s3) - (isnull issue:closed)) - :order-by [(desc updated)]] - (vconcat (closql--table-columns (forge-db) 'issue t)) - (oref repo id) - (ghub--username repo)))) - -;;; _ -(provide 'forge-issue) -;;; forge-issue.el ends here diff --git a/elpa/forge-20230505.926/forge-list.el b/elpa/forge-20230505.926/forge-list.el deleted file mode 100644 index edd4154f..00000000 --- a/elpa/forge-20230505.926/forge-list.el +++ /dev/null @@ -1,465 +0,0 @@ -;;; forge-list.el --- Tabulated-list interface -*- lexical-binding:t -*- - -;; Copyright (C) 2018-2023 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) - -(defvar x-stretch-cursor) - -;;; Options - -(defcustom forge-topic-list-mode-hook '(hl-line-mode) - "Hook run after entering Forge-Topic-List mode." - :package-version '(forge . "0.1.0") - :group 'forge - :type 'hook - :options '(hl-line-mode)) - -(defvar forge-topic-list-columns - '(("#" 5 forge-topic-list-sort-by-number (:right-align t) number nil) - ("Title" 35 t nil title nil) - )) - -(defvar forge-global-topic-list-columns - '(("Owner" 15 t nil repository:owner nil) - ("Name" 20 t nil repository:name nil) - ("#" 5 forge-topic-list-sort-by-number (:right-align t) number nil) - ("Title" 35 t nil title nil) - )) - -(defvar forge-repository-list-columns - '(("Owner" 20 t nil owner nil) - ("Name" 20 t nil name nil) - ("N" 1 t nil sparse-p nil) - ("S" 1 t nil selective-p nil) - ("Worktree" 99 t nil worktree nil) - )) - -(defcustom forge-owned-accounts nil - "An alist of accounts that are owned by you. -This should include your username as well as any organization -that you own. Used by the commands `forge-list-owned-issues', -`forge-list-owned-pullreqs' and `forge-fork'. - -Each element has the form (ACCOUNT . PLIST). The following -properties are currently being used: - -`remote-name' The default name suggested by `forge-fork' for a - fork created within this account. If unspecified, then the - name of the account is used." - :package-version '(forge . "0.2.0") - :group 'forge - :type '(repeat (cons (string :tag "Account") plist))) - -(define-obsolete-variable-alias 'forge-owned-blacklist - 'forge-owned-ignored "Forge 3.0.0") - -(defcustom forge-owned-ignored nil - "A list of repositories that are ignored when listing those owned by you. -This is a list of package names. Used by the commands -`forge-list-owned-issues' and `forge-list-owned-pullreqs'." - :package-version '(forge . "0.2.0") - :group 'forge - :type '(repeat (string :tag "Name"))) - -;;; Variables - -(defvar-local forge--tabulated-list-columns nil) -(put 'forge--tabulated-list-columns 'permanent-local t) - -(defvar-local forge--tabulated-list-query nil) -(put 'forge--tabulated-list-query 'permanent-local t) - -;;; Modes -;;;; Topics - -(defvar-keymap forge-topic-list-mode-map - :doc "Local keymap for Forge-Topic-List mode buffers." - :parent tabulated-list-mode-map - "RET" #'forge-visit-topic - "" #'forge-visit-topic - "o" #'forge-browse-topic - "'" #'forge-dispatch - "?" #'magit-dispatch) - -(define-derived-mode forge-topic-list-mode tabulated-list-mode - "Issues" - "Major mode for browsing a list of topics." - (setq-local x-stretch-cursor nil) - (setq tabulated-list-padding 0) - (setq tabulated-list-sort-key (cons "#" nil))) - -(define-derived-mode forge-issue-list-mode forge-topic-list-mode - "Issues" - "Major mode for browsing a list of issues.") - -(define-derived-mode forge-pullreq-list-mode forge-topic-list-mode - "Pull-Requests" - "Major mode for browsing a list of pull-requests.") - -(defun forge-topic-list-setup (mode id buffer-name columns fn) - (declare (indent 4)) - (let* ((repo (forge-get-repository (list :id id))) - (topdir (magit-toplevel))) - (with-current-buffer - (get-buffer-create - (or buffer-name - (format "*%s: %s/%s*" - (substring (symbol-name mode) 0 -5) - (oref repo owner) - (oref repo name)))) - (setq forge--tabulated-list-columns (or columns forge-topic-list-columns)) - (setq forge--tabulated-list-query fn) - (setq forge-buffer-repository repo) - (when topdir - (setq default-directory topdir)) - (cl-letf (((symbol-function #'tabulated-list-revert) #'ignore)) ; see #229 - (funcall mode)) - (forge-topic-list-refresh) - (add-hook 'tabulated-list-revert-hook - #'forge-topic-list-refresh nil t) - (tabulated-list-init-header) - (tabulated-list-print) - (switch-to-buffer (current-buffer))))) - -(defun forge-topic-list-refresh () - (setq tabulated-list-format - (vconcat (--map `(,@(-take 3 it) - ,@(-flatten (nth 3 it))) - forge--tabulated-list-columns))) - (tabulated-list-init-header) - (setq tabulated-list-entries - (mapcar #'forge--tablist-format-entry - (funcall forge--tabulated-list-query)))) - -;;;; Repository - -(defvar-keymap forge-repository-list-mode-map - :doc "Local keymap for Forge-Repository-List mode buffers." - :parent tabulated-list-mode-map - "RET" #'forge-visit-repository - "" #'forge-visit-repository - "o" #'forge-browse-repository - "'" #'forge-dispatch - "?" #'magit-dispatch) - -(define-derived-mode forge-repository-list-mode tabulated-list-mode - "Repositories" - "Major mode for browsing a list of repositories." - (setq-local x-stretch-cursor nil) - (setq forge--tabulated-list-columns forge-repository-list-columns) - (setq tabulated-list-padding 0) - (setq tabulated-list-sort-key (cons "Owner" nil)) - (setq tabulated-list-format - (vconcat (--map `(,@(-take 3 it) - ,@(-flatten (nth 3 it))) - forge-repository-list-columns))) - (tabulated-list-init-header)) - -(defun forge-repository-list-setup (fn buf) - (with-current-buffer (get-buffer-create buf) - (cl-letf (((symbol-function #'tabulated-list-revert) #'ignore)) ; see #229 - (forge-repository-list-mode)) - (funcall fn) - (add-hook 'tabulated-list-revert-hook fn nil t) - (tabulated-list-print) - (switch-to-buffer (current-buffer)))) - -(defun forge-repository-list-refresh () - (setq tabulated-list-entries - (mapcar #'forge--tablist-format-entry - (forge-sql [:select $i1 :from repository - :order-by [(asc owner) (asc name)]] - (forge--tablist-columns-vector))))) - -(defun forge-repository-list-owned-refresh () - (setq tabulated-list-entries - (mapcar #'forge--tablist-format-entry - (forge-sql [:select $i1 :from repository - :where (and (in owner $v2) - (not (in name $v3))) - :order-by [(asc owner) (asc name)]] - (forge--tablist-columns-vector) - (vconcat (mapcar #'car forge-owned-accounts)) - (vconcat forge-owned-ignored))))) - -;;; Commands -;;;; Topic - -;;;###autoload -(defun forge-list-topics (id) - "List topics of the current repository in a separate buffer." - (interactive (list (oref (forge-get-repository t) id))) - (forge-topic-list-setup #'forge-topic-list-mode id nil nil - (lambda () - (forge-sql [:select $i1 :from issue :where (= repository $s2) :union - :select $i1 :from pullreq :where (= repository $s2)] - (forge--tablist-columns-vector) - id)))) - -;;;; Issue - -;;;###autoload -(defun forge-list-issues (id) - "List issues of the current repository in a separate buffer." - (interactive (list (oref (forge-get-repository t) id))) - (forge-topic-list-setup #'forge-issue-list-mode id nil nil - (lambda () - (forge-sql [:select $i1 :from issue :where (= repository $s2)] - (forge--tablist-columns-vector) - id)))) - -;;;###autoload -(defun forge-list-labeled-issues (id label) - "List issues of the current repository that have LABEL. -List them in a separate buffer." - (interactive (list (oref (forge-get-repository t) id) - (magit-completing-read - "Label" - (mapcar #'cadr (oref (forge-get-repository t) labels)) - nil t))) - (forge-topic-list-setup #'forge-issue-list-mode id nil nil - (lambda () - (forge-sql [:select $i1 :from [issue issue_label label] - :where (and (= issue_label:issue issue:id) - (= issue_label:id label:id) - (= issue:repository $s2) - (= label:name $s3) - (isnull issue:closed)) - :order-by [(desc updated)]] - (forge--tablist-columns-vector 'issue) - id label)))) - -;;;###autoload -(defun forge-list-assigned-issues (id) - "List issues of the current repository that are assigned to you. -List them in a separate buffer." - (interactive (list (oref (forge-get-repository t) id))) - (forge-topic-list-setup #'forge-issue-list-mode id nil nil - (lambda () - (forge-sql [:select $i1 :from [issue issue_assignee assignee] - :where (and (= issue_assignee:issue issue:id) - (= issue_assignee:id assignee:id) - (= issue:repository $s2) - (= assignee:login $s3) - (isnull issue:closed)) - :order-by [(desc updated)]] - (forge--tablist-columns-vector 'issue) - id (ghub--username (forge-get-repository (list :id id))))))) - -;;;###autoload -(defun forge-list-owned-issues () - "List open issues from all your Github repositories. -Options `forge-owned-accounts' and `forge-owned-ignored' -controls which repositories are considered to be owned by you. -Only Github is supported for now." - (interactive) - (forge-topic-list-setup #'forge-issue-list-mode nil "My issues" - forge-global-topic-list-columns - (lambda () - (forge-sql [:select $i1 :from [issue repository] - :where (and (= issue:repository repository:id) - (in repository:owner $v2) - (not (in repository:name $v3)) - (isnull issue:closed)) - :order-by [(asc repository:owner) - (asc repository:name) - (desc issue:number)]] - (forge--tablist-columns-vector 'issue) - (vconcat (mapcar #'car forge-owned-accounts)) - (vconcat forge-owned-ignored))))) - -;;;; Pullreq - -;;;###autoload -(defun forge-list-pullreqs (id) - "List pull-requests of the current repository in a separate buffer." - (interactive (list (oref (forge-get-repository t) id))) - (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil - (lambda () - (forge-sql [:select $i1 :from pullreq :where (= repository $s2)] - (forge--tablist-columns-vector) - id)))) - -;;;###autoload -(defun forge-list-labeled-pullreqs (id label) - "List pull-requests of the current repository that have LABEL. -List them in a separate buffer." - (interactive (list (oref (forge-get-repository t) id) - (magit-completing-read - "Label" - (mapcar #'cadr (oref (forge-get-repository t) labels)) - nil t))) - (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil - (lambda () - (forge-sql [:select $i1 :from [pullreq pullreq_label label] - :where (and (= pullreq_label:pullreq pullreq:id) - (= pullreq_label:id label:id) - (= pullreq:repository $s2) - (= label:name $s3) - (isnull pullreq:closed)) - :order-by [(desc updated)]] - (forge--tablist-columns-vector 'pullreq) - id label)))) - -;;;###autoload -(defun forge-list-assigned-pullreqs (id) - "List pull-requests of the current repository that are assigned to you. -List them in a separate buffer." - (interactive (list (oref (forge-get-repository t) id))) - (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil - (lambda () - (forge-sql [:select $i1 :from [pullreq pullreq_assignee assignee] - :where (and (= pullreq_assignee:pullreq pullreq:id) - (= pullreq_assignee:id assignee:id) - (= pullreq:repository $s2) - (= assignee:login $s3) - (isnull pullreq:closed)) - :order-by [(desc updated)]] - (forge--tablist-columns-vector 'pullreq) - id (ghub--username (forge-get-repository (list :id id))))))) - -;;;###autoload -(defun forge-list-requested-reviews (id) - "List pull-requests of the current repository that are awaiting your review. -List them in a separate buffer." - (interactive (list (oref (forge-get-repository t) id))) - (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil - (lambda () - (forge-sql [:select $i1 :from [pullreq pullreq_review_request assignee] - :where (and (= pullreq_review_request:pullreq pullreq:id) - (= pullreq_review_request:id assignee:id) - (= pullreq:repository $s2) - (= assignee:login $s3) - (isnull pullreq:closed)) - :order-by [(desc updated)]] - (forge--tablist-columns-vector 'pullreq) - id (ghub--username (forge-get-repository (list :id id))))))) - -;;;###autoload -(defun forge-list-owned-pullreqs () - "List open pull-requests from all your Github repositories. -Options `forge-owned-accounts' and `forge-owned-ignored' -controls which repositories are considered to be owned by you. -Only Github is supported for now." - (interactive) - (forge-topic-list-setup #'forge-pullreq-list-mode nil "My pullreqs" - forge-global-topic-list-columns - (lambda () - (forge-sql [:select $i1 :from [pullreq repository] - :where (and (= pullreq:repository repository:id) - (in repository:owner $v2) - (not (in repository:name $v3)) - (isnull pullreq:closed)) - :order-by [(asc repository:owner) - (asc repository:name) - (desc pullreq:number)]] - (forge--tablist-columns-vector 'pullreq) - (vconcat (mapcar #'car forge-owned-accounts)) - (vconcat forge-owned-ignored))))) - -;;;###autoload -(defun forge-list-authored-pullreqs (id) - "List open pull-requests of the current repository that are authored by you. -List them in a separate buffer." - (interactive (list (oref (forge-get-repository t) id))) - (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil - (lambda () - (forge-sql [:select $i1 :from [pullreq] - :where (and (= pullreq:repository $s2) - (= pullreq:author $s3) - (isnull pullreq:closed)) - :order-by [(desc updated)]] - (forge--tablist-columns-vector 'pullreq) - id (ghub--username (forge-get-repository (list :id id))))))) - -;;;###autoload -(defun forge-list-authored-issues (id) - "List open issues from the current repository that are authored by you. -List them in a separate buffer." - (interactive (list (oref (forge-get-repository t) id))) - (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil - (lambda () - (forge-sql [:select $i1 :from [issue] - :where (and (= issue:repository $s2) - (= issue:author $s3) - (isnull issue:closed)) - :order-by [(desc updated)]] - (forge--tablist-columns-vector 'issue) - id (ghub--username (forge-get-repository (list :id id))))))) - -;;;; Repository - -;;;###autoload -(defun forge-list-repositories () - "List known repositories in a separate buffer. -Here \"known\" means that an entry exists in the local database." - (interactive) - (forge-repository-list-setup #'forge-repository-list-refresh - "*Forge Repositories*")) - -;;;###autoload -(defun forge-list-owned-repositories () - "List your own known repositories in a separate buffer. -Here \"known\" means that an entry exists in the local database -and options `forge-owned-accounts' and `forge-owned-ignored' -controls which repositories are considered to be owned by you. -Only Github is supported for now." - (interactive) - (forge-repository-list-setup #'forge-repository-list-owned-refresh - "*Forge Owned Repositories*")) - -;;; Internal - -(defun forge-topic-list-sort-by-number (a b) - "Sort the `tabulated-list-entries' by topic number. -This assumes that `number' is the first column, otherwise -it silently fails." - (ignore-errors - (> (read (aref (cadr a) 0)) - (read (aref (cadr b) 0))))) - -(defun forge--tablist-columns-vector (&optional table) - (let ((columns (cons 'id (--map (nth 4 it) forge--tabulated-list-columns)))) - (vconcat (if table - (let ((table (symbol-name table))) - (--map (let ((col (symbol-name it))) - (if (string-search ":" col) - it - (intern (concat table ":" col)))) - columns)) - columns)))) - -(defun forge--tablist-format-entry (row) - (list (car row) - (vconcat - (cl-mapcar (lambda (val col) - (if-let ((pp (nth 5 col))) - (funcall pp val) - (if val (format "%s" val) ""))) - (cdr row) - forge--tabulated-list-columns)))) - -;;; _ -(provide 'forge-list) -;;; forge-list.el ends here diff --git a/elpa/forge-20230505.926/forge-notify.el b/elpa/forge-20230505.926/forge-notify.el deleted file mode 100644 index 471deed7..00000000 --- a/elpa/forge-20230505.926/forge-notify.el +++ /dev/null @@ -1,151 +0,0 @@ -;;; forge-notify.el --- Notify support -*- lexical-binding:t -*- - -;; Copyright (C) 2018-2023 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) - -;;; Class - -(defclass forge-notification (forge-object) - ((closql-class-prefix :initform "forge-") - (closql-table :initform 'notification) - (closql-primary-key :initform 'id) - (closql-order-by :initform [(desc id)]) - (id :initarg :id) - (thread-id :initarg :thread-id) - (repository :initarg :repository) - (forge :initarg :forge) - (reason :initarg :reason) - (unread-p :initarg :unread-p) - (last-read :initarg :last-read) - (updated :initarg :updated) - (title :initarg :title) - (type :initarg :type) - (topic :initarg :topic) - (url :initarg :url))) - -;;; Core - -(cl-defmethod forge-get-repository ((notify forge-notification)) - "Return the object for the repository that NOTIFY belongs to." - (and-let* ((id (oref notify repository))) - (closql-get (forge-db) id 'forge-repository))) - -(cl-defmethod forge-get-notification ((topic forge-topic)) - (and-let* ((row (car (forge-sql [:select * :from notification - :where (and (= repository $s1) - (= topic $s2))] - (oref topic repository) - (oref topic number))))) - (closql--remake-instance 'forge-notification (forge-db) row))) - -;;; Utilities - -(cl-defmethod forge-get-url ((notify forge-notification)) - (oref notify url)) - -;;; Mode - -(defvar-keymap forge-notifications-mode-map - :doc "Keymap for `forge-notifications-mode'." - :parent magit-mode-map) - -(define-derived-mode forge-notifications-mode magit-mode "Forge Notifications" - "Mode for looking at forge notifications." - (hack-dir-local-variables-non-file-buffer)) - -(defun forge-notifications-setup-buffer () - ;; There should only ever be one such buffer. - (cl-letf (((symbol-function 'magit-get-mode-buffer) - (lambda (&rest _) - (get-buffer-create "*forge-notifications*")))) - (magit-setup-buffer #'forge-notifications-mode))) - -(defun forge-notifications-refresh-buffer () - (forge-insert-notifications)) - -;;; Utilities - -(defun forge--list-notifications-all () - (closql-query (forge-db) nil nil 'forge-notification)) - -(defun forge--list-notifications-unread () - (mapcar (lambda (row) - (closql--remake-instance 'forge-notification (forge-db) row)) - (forge-sql [:select * :from notification - :where (notnull unread-p) - :order-by [(desc id)]]))) - -;;; Sections - -;; The double-prefix is necessary due to a limitation of magit-insert-section. -(defvar-keymap forge-forge-repo-section-map - " " #'forge-browse-repository - " " #'forge-visit-repository) - -(defun forge-insert-notifications () - (when-let ((ns (forge--list-notifications-all))) - (magit-insert-section (notifications) - (magit-insert-heading "Notifications:") - (pcase-dolist (`(,_ . ,ns) (--group-by (oref it repository) ns)) - (let ((repo (forge-get-repository (car ns)))) - (magit-insert-section (forge-repo repo t) - (magit-insert-heading - (concat (propertize (format "%s/%s" - (oref repo owner) - (oref repo name)) - 'font-lock-face 'bold) - (format " (%s)" (length ns)))) - (magit-insert-section-body - (dolist (notify ns) - (with-slots (type topic title url unread-p) notify - (pcase type - ('issue - (forge-insert-topic (forge-get-issue repo topic))) - ('pullreq - (forge-insert-topic (forge-get-pullreq repo topic))) - ('commit - (magit-insert-section (ncommit nil) ; !commit - (string-match "[^/]*\\'" url) - (insert - (format "%s %s\n" - (propertize (substring (match-string 0 url) - 0 (magit-abbrev-length)) - 'font-lock-face 'magit-hash) - (magit-log-propertize-keywords - nil (propertize title 'font-lock-face - (if unread-p - 'forge-topic-unread - 'forge-topic-open))))))) - (_ - ;; The documentation does not mention what "types" - ;; exist. Make it obvious that this is something - ;; we do not know how to handle properly yet. - (magit-insert-section (notification notify) - (insert (propertize (format "(%s) %s\n" type title) - 'font-lock-face 'error))))))) - (insert ?\n)))))))) - -;;; _ -(provide 'forge-notify) -;;; forge-notify.el ends here diff --git a/elpa/forge-20230505.926/forge-pkg.el b/elpa/forge-20230505.926/forge-pkg.el deleted file mode 100644 index 7f28e073..00000000 --- a/elpa/forge-20230505.926/forge-pkg.el +++ /dev/null @@ -1,22 +0,0 @@ -(define-package "forge" "20230505.926" "Access Git forges from Magit." - '((emacs "25.1") - (compat "29.1.3.4") - (closql "20230407") - (dash "2.19.1") - (emacsql "20230409") - (ghub "20220621") - (let-alist "1.0.6") - (magit "20230319") - (markdown-mode "2.4") - (transient "0.3.6") - (yaml "0.3.5")) - :commit "12428a702fc6c9b2b36896803e6022baafcad3cd" :authors - '(("Jonas Bernoulli" . "jonas@bernoul.li")) - :maintainer - '("Jonas Bernoulli" . "jonas@bernoul.li") - :keywords - '("git" "tools" "vc") - :url "https://github.com/magit/forge") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/forge-20230505.926/forge-post.el b/elpa/forge-20230505.926/forge-post.el deleted file mode 100644 index 4e76e6e1..00000000 --- a/elpa/forge-20230505.926/forge-post.el +++ /dev/null @@ -1,286 +0,0 @@ -;;; forge-post.el --- Post support -*- lexical-binding:t -*- - -;; Copyright (C) 2018-2023 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 - -(cl-defmethod forge-get-parent ((post forge-post)) - (forge-get-topic post)) - -(cl-defmethod forge-get-repository ((post forge-post)) - (forge-get-repository (forge-get-topic post))) - -;;; Utilities - -(cl-defmethod forge-get-url ((post forge-post)) - (forge--format post (let ((topic (forge-get-parent post))) - (cond ((forge--childp topic 'forge-issue) - 'issue-post-url-format) - ((forge--childp topic 'forge-pullreq) - 'pullreq-post-url-format))))) - -(cl-defmethod forge-browse :after ((post forge-post)) - (oset (forge-get-topic post) unread-p nil)) - -;;; Sections - -(defun forge-post-at-point () - (magit-section-value-if '(issue pullreq post))) - -(defun forge-comment-at-point () - (and (magit-section-value-if '(post)) - (let ((post (oref (magit-current-section) value))) - (and (or (forge-pullreq-post-p post) - (forge-issue-post-p post)) - post)))) - -(defun forge-topic-at-point () - (or (magit-section-value-if '(issue pullreq)) - (and-let* ((branch (magit-branch-at-point)) - (n (magit-get "branch" branch "pullRequest"))) - (forge-get-pullreq (string-to-number n))) - (and-let* ((rev (magit-commit-at-point))) - (forge--pullreq-from-rev rev)) - (forge--issue-by-forge-short-link-at-point) - (forge--pullreq-by-forge-short-link-at-point))) - -(defun forge-current-topic () - (or (forge-topic-at-point) - (and (derived-mode-p 'forge-topic-mode) - forge-buffer-topic) - (and (derived-mode-p 'forge-topic-list-mode) - (forge-get-topic (tabulated-list-get-id))))) - -(defun forge--pullreq-from-rev (rev) - (and-let* ((repo (forge-get-repository nil)) - (refspec (oref repo pullreq-refspec)) - (name (magit-rev-name rev (cadr (split-string refspec ":"))))) - (save-match-data - (and (string-match "\\([0-9]*\\)\\([~^][0-9]*\\)?\\'" name) - (forge-get-pullreq (string-to-number (match-string 0 name))))))) - -;;; Utilities - -(cl-defmethod forge--format ((post forge-post) slot &optional spec) - (forge--format (forge-get-topic post) slot - `(,@spec (?I . ,(oref post number))))) - -;;; Mode - -(defvar-keymap forge-post-mode-map - "C-c C-e" #'forge-post-dispatch - "C-c C-c" #'forge-post-submit - " " #'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 t) - (if source 'forge-pullreq 'forge-issue)) - (cond - (.url - (browse-url .url) - (forge-post-cancel) - (setq buf nil) - (message "Using browser to visit %s instead of opening an issue" - .url)) - (.name - ;; A Github issue with yaml frontmatter. - (save-excursion (insert .text)) - (unless (re-search-forward "^title: " nil t) - (when (re-search-forward "^---" nil t 2) - (beginning-of-line) - (insert "title: \n") - (backward-char)))) - (t - (insert "# ") - (let ((single - (and source - (= (car (magit-rev-diff-count source target)) 1)))) - (save-excursion - (when single - ;; A pull-request. - (magit-rev-insert-format "%B" source)) - (when .text - (if single - (insert "-------\n") - (insert "\n")) - (insert "\n" .text))))))))) - buf))) - -(defun forge--display-post-buffer (buf) - (magit-display-buffer buf #'display-buffer)) - -(defun forge-post-cancel () - "Cancel the post that is being edited in the current buffer." - (interactive) - (save-buffer) - (if-let ((fn forge--cancel-post-function)) - (funcall fn forge--buffer-post-object) - (magit-mode-bury-buffer 'kill))) - -(defun forge-post-submit () - "Submit the post that is being edited in the current buffer." - (interactive) - (save-buffer) - (if-let ((fn forge--submit-post-function)) - (funcall fn - (forge-get-repository forge--buffer-post-object) - forge--buffer-post-object) - (error "forge--submit-post-function is nil"))) - -(defun forge--post-submit-callback () - (let* ((file buffer-file-name) - (editbuf (current-buffer)) - (prevbuf forge--pre-post-buffer) - (topic (ignore-errors (forge-get-topic forge--buffer-post-object))) - (repo (forge-get-repository topic))) - (lambda (value headers status req) - (run-hook-with-args 'forge-post-submit-callback-hook - value headers status req) - (delete-file file t) - (let ((dir (file-name-directory file))) - (unless (cddr (directory-files dir nil nil t)) - (delete-directory dir nil t))) - (when (buffer-live-p editbuf) - (with-current-buffer editbuf - (magit-mode-bury-buffer 'kill))) - (with-current-buffer - (if (buffer-live-p prevbuf) prevbuf (current-buffer)) - (if (and topic - (forge--childp repo 'forge-github-repository) - (or (and (fboundp 'forge-pullreq-p) - (forge-pullreq-p topic)) - (oref repo selective-p))) - (forge--pull-topic repo topic) - (forge-pull)))))) - -(defun forge--post-submit-errorback () - (lambda (error &rest _) - (error "Failed to submit post: %S" error))) - -(transient-define-prefix forge-post-dispatch () - "Dispatch a post creation command." - ["Variables" - ("d" "Create draft" forge-post-toggle-draft)] - ["Act" - ("C-c" "Submit" forge-post-submit) - ("C-k" "Cancel" forge-post-cancel)]) - -(transient-define-infix forge-post-toggle-draft () - "Toggle whether the pull-request being created is a draft." - :class 'transient-lisp-variable - :variable 'forge-buffer-draft-p - :reader (lambda (&rest _) (not forge-buffer-draft-p)) - :if (lambda () (equal (file-name-nondirectory buffer-file-name) "new-pullreq"))) - -;;; Notes - -(defclass forge-note (forge-post) ()) - -(defvar-keymap forge-note-section-map - " " #'forge-edit-topic-note) - -(defun forge--save-note (_repo topic) - (let ((value (string-trim (buffer-substring-no-properties - (point-min) - (point-max))))) - (oset topic note (if (equal value "") nil value))) - (delete-file buffer-file-name t) - (let ((dir (file-name-directory buffer-file-name))) - (unless (cddr (directory-files dir nil nil t)) - (delete-directory dir))) - (let ((prevbuf forge--pre-post-buffer)) - (magit-mode-bury-buffer 'kill) - (when (buffer-live-p prevbuf) - (magit-refresh)))) - -;;; _ -(provide 'forge-post) -;;; forge-post.el ends here diff --git a/elpa/forge-20230505.926/forge-pullreq.el b/elpa/forge-20230505.926/forge-pullreq.el deleted file mode 100644 index 7231a5b1..00000000 --- a/elpa/forge-20230505.926/forge-pullreq.el +++ /dev/null @@ -1,330 +0,0 @@ -;;; forge-pullreq.el --- Pullreq support -*- lexical-binding:t -*- - -;; Copyright (C) 2018-2023 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) - (closed :initarg :closed) - (merged :initarg :merged) - (unread-p :initarg :unread-p :initform nil) - (locked-p :initarg :locked-p) - (editable-p :initarg :editable-p) - (cross-repo-p :initarg :cross-repo-p) - (base-ref :initarg :base-ref) - (base-repo :initarg :base-repo) - (head-ref :initarg :head-ref) - (head-user :initarg :head-user) - (head-repo :initarg :head-repo) - (milestone :initarg :milestone) - (body :initarg :body) - (assignees :closql-table (pullreq-assignee assignee)) - (project-cards) ; projectsCards - (commits) - (edits) ; userContentEdits - (labels :closql-table (pullreq-label label)) - (participants) - (posts :closql-class forge-pullreq-post) - (reactions) - (review-requests :closql-table (pullreq-review-request assignee)) - (reviews) - (timeline) - (marks :closql-table (pullreq-mark mark)) - (note :initarg :note :initform nil) - (base-rev :initarg :base-rev) - (head-rev :initarg :head-rev) - (draft-p :initarg :draft-p) - (their-id :initarg :their-id) - )) - -(defclass forge-pullreq-post (forge-post) - ((closql-table :initform 'pullreq-post) - (closql-primary-key :initform 'id) - (closql-order-by :initform [(asc number)]) - (closql-foreign-key :initform 'pullreq) - (closql-class-prefix :initform "forge-pullreq-") - (id :initarg :id) - (pullreq :initarg :pullreq) - (number :initarg :number) - (author :initarg :author) - (created :initarg :created) - (updated :initarg :updated) - (body :initarg :body) - (edits) - (reactions) - )) - -;;; Query - -(cl-defmethod forge-get-repository ((post forge-pullreq-post)) - (forge-get-repository (forge-get-pullreq post))) - -(cl-defmethod forge-get-topic ((post forge-pullreq-post)) - (forge-get-pullreq post)) - -(cl-defmethod forge-get-pullreq ((pullreq forge-pullreq)) - pullreq) - -(cl-defmethod forge-get-pullreq ((repo forge-repository) number) - (closql-get (forge-db) - (forge--object-id 'forge-pullreq repo number) - 'forge-pullreq)) - -(cl-defmethod forge-get-pullreq ((number integer)) - (and-let* ((repo (forge-get-repository t))) - (forge-get-pullreq repo number))) - -(cl-defmethod forge-get-pullreq ((id string)) - (closql-get (forge-db) id 'forge-pullreq)) - -(cl-defmethod forge-get-pullreq ((post forge-pullreq-post)) - (closql-get (forge-db) - (oref post pullreq) - 'forge-pullreq)) - -(cl-defmethod forge-ls-pullreqs ((repo forge-repository) &optional type select) - (forge-ls-topics repo 'forge-pullreq type select)) - -;;; Utilities - -(defun forge-read-pullreq (prompt &optional type) - (when (eq type t) - (setq type (if current-prefix-arg nil 'open))) - (let* ((default (forge-current-pullreq)) - (repo (forge-get-repository (or default t))) - (choices (mapcar - (apply-partially #'forge--topic-format-choice repo) - (forge-ls-pullreqs repo type [number title id class])))) - (cdr (assoc (magit-completing-read - prompt choices nil nil nil nil - (and default - (setq default (forge--topic-format-choice default)) - (member default choices) - (car default))) - choices)))) - -(defun forge--pullreq-branch-internal (pullreq) - (let ((branch (oref pullreq head-ref))) - ;; It is invalid for a branch name to begin with a colon, yet - ;; that is what Gitlab uses when a pull-request's source branch - ;; has been deleted. On Github this is simply nil in the same - ;; situation. - (and branch (not (string-prefix-p ":" branch)) branch))) - -(defun forge--pullreq-branch-active (pullreq) - (let* ((number (number-to-string (oref pullreq number))) - (branch-n (format "pr-%s" number)) - (branch (forge--pullreq-branch-internal pullreq))) - (or (and (magit-branch-p branch) - (equal (magit-get "branch" branch "pullRequest") number) - branch) - (and (magit-branch-p branch-n) - (equal (magit-get "branch" branch-n "pullRequest") number) - branch-n)))) - -(defun forge--pullreq-ref (pullreq) - (let ((ref (format "refs/pullreqs/%s" (oref pullreq number)))) - (and (magit-rev-verify ref) ref))) - -(defun forge--pullreq-range (pullreq &optional endpoints) - (and-let* ((head (forge--pullreq-ref pullreq))) - (concat (forge--get-remote) "/" (oref pullreq base-ref) - (if endpoints "..." "..") - head))) - -(cl-defmethod forge-get-url ((pullreq forge-pullreq)) - (forge--format pullreq 'pullreq-url-format)) - -(defun forge--pullreq-by-forge-short-link-at-point () - (forge--topic-by-forge-short-link-at-point '("#" "!") #'forge-get-pullreq)) - -;;; Sections - -(defun forge-current-pullreq () - (or (forge-pullreq-at-point) - (and (derived-mode-p 'forge-topic-mode) - (forge-pullreq-p forge-buffer-topic) - forge-buffer-topic) - (and (derived-mode-p 'forge-topic-list-mode) - (let ((topic (forge-get-topic (tabulated-list-get-id)))) - (and (forge-pullreq-p topic) - topic))))) - -(defun forge-pullreq-at-point () - (or (magit-section-value-if 'pullreq) - (and-let* ((post (magit-section-value-if 'post))) - (cond ((forge-pullreq-p post) - post) - ((forge-pullreq-post-p post) - (forge-get-pullreq post)))) - (forge--pullreq-by-forge-short-link-at-point))) - -(defvar-keymap forge-pullreqs-section-map - " " #'forge-browse-pullreqs - " " #'forge-list-pullreqs - "C-c C-n" #'forge-create-pullreq) - -(defvar-keymap forge-pullreq-section-map - " " #'forge-browse-pullreq - " " #'forge-visit-pullreq) - -(defun forge-insert-pullreqs () - "Insert a list of mostly recent and/or open pull-requests. -Also see option `forge-topic-list-limit'." - (when (and forge-display-in-status-buffer (forge-db t)) - (when-let ((repo (forge-get-repository nil))) - (unless (oref repo sparse-p) - (forge-insert-topics "Pull requests" - (forge-ls-recent-topics repo 'pullreq) - (forge--topic-type-prefix repo 'pullreq)))))) - -(defun forge--insert-pullreq-commits (pullreq &optional all) - (cl-letf (((symbol-function #'magit-cancel-section) (lambda ()))) - (if all - ;; Numeric pr ref, pr branch (if it exists) and api - ;; pr range may be out of sync. Just show them all. - (magit-insert-section-body - (magit--insert-log nil - (delq nil (list (concat "^" (or (oref pullreq base-rev) - (concat (forge--get-remote) "/" - (oref pullreq base-ref)))) - (forge--pullreq-ref pullreq) - (forge--pullreq-branch-active pullreq) - (and-let* ((branch (oref pullreq head-ref))) - (and (magit-local-branch-p branch) branch)))) - (seq-uniq (cons "--graph" magit-buffer-log-args))) - (magit-make-margin-overlay nil t)) - (when-let ((range (forge--pullreq-range pullreq))) - (magit-insert-section-body - (magit--insert-log nil range magit-buffer-log-args) - (magit-make-margin-overlay nil t)))))) - -(cl-defmethod forge--insert-topic-contents :after ((pullreq forge-pullreq) - _width _prefix) - (unless (oref pullreq merged) - (magit-insert-heading) - (forge--insert-pullreq-commits pullreq))) - -(cl-defmethod forge--format-topic-id ((pullreq forge-pullreq) &optional prefix) - (propertize (format "%s%s" - (or prefix (forge--topic-type-prefix pullreq)) - (oref pullreq number)) - 'font-lock-face (if (oref pullreq merged) - 'forge-topic-merged - 'forge-topic-unmerged))) - -(cl-defmethod forge--topic-type-prefix ((pullreq forge-pullreq)) - (if (forge--childp (forge-get-repository pullreq) 'forge-gitlab-repository) - "!" - "#")) - -(defun forge-insert-assigned-pullreqs () - "Insert a list of open pull-requests that are assigned to you." - (when forge-display-in-status-buffer - (when-let ((repo (forge-get-repository nil))) - (unless (oref repo sparse-p) - (forge-insert-topics "Assigned pull requests" - (forge--ls-assigned-pullreqs repo) - (forge--topic-type-prefix repo 'pullreq)))))) - -(defun forge--ls-assigned-pullreqs (repo) - (mapcar (lambda (row) - (closql--remake-instance 'forge-pullreq (forge-db) row)) - (forge-sql - [:select $i1 :from pullreq - :join pullreq_assignee :on (= pullreq_assignee:pullreq pullreq:id) - :join assignee :on (= pullreq_assignee:id assignee:id) - :where (and (= pullreq:repository $s2) - (= assignee:login $s3) - (isnull pullreq:closed)) - :order-by [(desc updated)]] - (vconcat (closql--table-columns (forge-db) 'pullreq t)) - (oref repo id) - (ghub--username repo)))) - -(defun forge-insert-requested-reviews () - "Insert a list of pull-requests that are awaiting your review." - (when-let ((repo (forge-get-repository nil))) - (unless (oref repo sparse-p) - (forge-insert-topics "Pull requests awaiting review" - (forge--ls-requested-reviews repo) - (forge--topic-type-prefix repo 'pullreq))))) - -(defun forge--ls-requested-reviews (repo) - (mapcar - (lambda (row) - (closql--remake-instance 'forge-pullreq (forge-db) row)) - (forge-sql - [:select $i1 :from pullreq - :join pullreq_review_request :on (= pullreq_review_request:pullreq pullreq:id) - :join assignee :on (= pullreq_review_request:id assignee:id) - :where (and (= pullreq:repository $s2) - (= assignee:login $s3) - (isnull pullreq:closed)) - :order-by [(desc updated)]] - (vconcat (closql--table-columns (forge-db) 'pullreq t)) - (oref repo id) - (ghub--username repo)))) - -(defun forge-insert-authored-pullreqs () - "Insert a list of open pullreqs that are authored to you." - (when forge-display-in-status-buffer - (when-let ((repo (forge-get-repository nil))) - (unless (oref repo sparse-p) - (forge-insert-topics "Authored pullreqs" - (forge--ls-authored-pullreqs repo) - (forge--topic-type-prefix repo 'pullreq)))))) - -(defun forge--ls-authored-pullreqs (repo) - (mapcar (lambda (row) - (closql--remake-instance 'forge-pullreq (forge-db) row)) - (forge-sql - [:select $i1 :from [pullreq] - :where (and (= pullreq:repository $s2) - (= pullreq:author $s3) - (isnull pullreq:closed)) - :order-by [(desc updated)]] - (vconcat (closql--table-columns (forge-db) 'pullreq t)) - (oref repo id) - (ghub--username repo)))) - -;;; _ -(provide 'forge-pullreq) -;;; forge-pullreq.el ends here diff --git a/elpa/forge-20230505.926/forge-repo.el b/elpa/forge-20230505.926/forge-repo.el deleted file mode 100644 index e3189bf8..00000000 --- a/elpa/forge-20230505.926/forge-repo.el +++ /dev/null @@ -1,378 +0,0 @@ -;;; forge-repo.el --- Repository support -*- lexical-binding:t -*- - -;; Copyright (C) 2018-2023 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) - (sparse-p :initform t) - (created :initform nil) - (updated :initform nil) - (pushed :initform nil) - (parent :initform nil) - (description :initform nil) - (homepage :initform nil) - (default-branch :initform nil) - (archived-p :initform nil) - (fork-p :initform nil) - (locked-p :initform nil) - (mirror-p :initform nil) - (private-p :initform nil) - (issues-p :initform t) - (wiki-p :initform nil) - (stars :initform nil) - (watchers :initform nil) - (assignees :closql-table assignee) - (forks :closql-table fork) - (issues :closql-class forge-issue) - (labels :closql-table label) - (pullreqs :closql-class forge-pullreq) - (revnotes :closql-class forge-revnote) - (selective-p :initform nil) - (worktree :initform nil) - (milestones :closql-table milestone)) - :abstract t) - -(defclass forge-unusedapi-repository (forge-repository) () :abstract t) - -(defclass forge-noapi-repository (forge-repository) () :abstract t) - -;;; Core - -(cl-defmethod forge--repository-ids ((class (subclass forge-repository)) - host owner name &optional stub) - "Return (OUR-ID . THEIR-ID) of the specified repository. -If optional STUB is non-nil, then the IDs are not guaranteed to -be unique. Otherwise this method has to make an API request to -retrieve THEIR-ID, the repository's ID on the forge. In that -case OUR-ID derives from THEIR-ID and is unique across all -forges and hosts." - (pcase-let* ((`(,_githost ,apihost ,id ,_class) - (or (assoc host forge-alist) - (error "No entry for %S in forge-alist" host))) - (path (format "%s/%s" owner name)) - (their-id (and (not stub) - (ghub-repository-id - owner name - :host apihost - :auth 'forge - :forge (forge--ghub-type-symbol class))))) - (cons (base64-encode-string - (format "%s:%s" id - (cond (stub path) - ((eq class 'forge-github-repository) - ;; This is base64 encoded, according to - ;; https://docs.github.com/en/graphql/reference/scalars#id. - ;; Unfortunately that is not always true. - ;; E.g. https://github.com/dit7ya/roamex. - (condition-case nil - (base64-decode-string their-id) - (error their-id))) - (t their-id))) - t) - (or their-id path)))) - -(cl-defmethod forge--repository-ids ((_class (subclass forge-noapi-repository)) - host owner name &optional _stub) - (let ((their-id (if owner (concat owner "/" name) name))) - (cons (base64-encode-string - (format "%s:%s" - (nth 3 (or (assoc host forge-alist) - (error "No entry for %S in forge-alist" host))) - their-id) - t) - their-id))) - -(defvar-local forge-buffer-repository nil) -(put 'forge-buffer-repository 'permanent-local t) - -(defconst forge--signal-no-entry '(t stub create)) - -(defun forge--get-remote (&optional warn) - (let* ((remotes (magit-list-remotes)) - (config (magit-get "forge.remote")) - (remote (if (cdr remotes) - (or (car (member config remotes)) - (car (member "upstream" remotes)) - (car (member "origin" remotes))) - (car remotes)))) - (when (and warn config remote (not (equal config remote))) - (message "Ignored forge.remote=%s; no such remote.\nSee %s." config - "https://magit.vc/manual/forge/Repository-Detection.html")) - remote)) - -(cl-defmethod forge-get-repository (((_ id) (head :id))) - (closql-get (forge-db) id 'forge-repository)) - -(cl-defmethod forge-get-repository ((demand symbol) &optional remote) - "Return the current forge repository. - -If the `forge-buffer-repository' is non-nil, then return that. -Otherwise if `forge-buffer-topic' is non-nil, then return the -repository for that. Finally if both variables are nil, then -return the forge repository corresponding to the current Git -repository, if any." - (or forge-buffer-repository - (and forge-buffer-topic - (forge-get-repository forge-buffer-topic)) - (magit--with-refresh-cache - (list default-directory 'forge-get-repository demand) - (unless remote - (setq remote (forge--get-remote 'warn))) - (if-let ((url (and remote - (magit-git-string "remote" "get-url" remote)))) - (when-let* ((repo (forge-get-repository url remote demand))) - ;; Cannot use and-let* because of debbugs#31840. - (oset repo worktree (magit-toplevel)) - repo) - (when (memq demand forge--signal-no-entry) - (error - "Cannot determine forge repository. %s\nSee %s." - (cond (remote (format "No url configured for %S." remote)) - ((and-let* ((config (magit-get "forge.remote"))) - (format "Value of `forge.remote' is %S but %s" - config "that remote does not exist."))) - ((magit-list-remotes) "Cannot decide on remote to use.") - (t "No remote configured.")) - "https://magit.vc/manual/forge/Repository-Detection.html")))))) - -(cl-defmethod forge-get-repository ((url string) &optional remote demand) - "Return the repository at URL." - (if-let ((parts (forge--split-url url))) - (forge-get-repository parts remote demand) - (when (memq demand forge--signal-no-entry) - (error "Cannot determine forge repository. %s isn't a forge url" url)))) - -(cl-defmethod forge-get-repository (((host owner name) list) - &optional remote demand) - "((host owner name) &optional remote demand) - -Return the repository identified by HOST, OWNER and NAME." - (if-let ((spec (assoc host forge-alist))) - (pcase-let ((`(,githost ,apihost ,forge ,class) spec)) - (let* ((row (car (forge-sql [:select * :from repository - :where (and (= forge $s1) - (= owner $s2) - (= name $s3))] - forge owner name))) - (obj (and row (closql--remake-instance class (forge-db) row)))) - (when obj - (oset obj apihost apihost) - (oset obj githost githost) - (oset obj remote remote)) - (cond ((and (eq demand t) - (or (not obj) - (oref obj sparse-p))) - (error "Cannot use `%s' in %S yet.\n%s" - this-command (magit-toplevel) - "Use `M-x forge-add-repository' before trying again.")) - ((and (eq demand 'full) obj - (oref obj sparse-p)) - (setq obj nil))) - (when (and (memq demand '(stub create)) - (not obj)) - (pcase-let ((`(,id . ,forge-id) - (forge--repository-ids class host owner name - (eq demand 'stub)))) - ;; The repo might have been renamed on the forge. #188 - (unless (setq obj (forge-get-repository (list :id id))) - (setq obj (funcall class - :id id - :forge-id forge-id - :forge forge - :owner owner - :name name - :apihost apihost - :githost githost - :remote remote)) - (when (eq demand 'create) - (closql-insert (forge-db) obj))))) - obj)) - (when (memq demand forge--signal-no-entry) - (error "Cannot determine forge repository. No entry for %S in %s" - host 'forge-alist)))) - -(cl-defmethod forge-get-repository ((repo forge-repository)) - repo) - -;;; Utilities - -(defun forge-repository-at-point () - (magit-section-value-if 'forge-repo)) - -(defun forge-current-repository () - (or (forge-repository-at-point) - (and (derived-mode-p 'forge-repository-list-mode) - (forge-get-repository (list :id (tabulated-list-get-id)))))) - -(cl-defmethod forge-visit ((repo forge-repository)) - (let ((worktree (oref repo worktree))) - (if (and worktree (file-directory-p worktree)) - (magit-status-setup-buffer worktree) - (forge-list-issues (oref repo id))))) - -(defun forge-read-repository (prompt) - (let ((choice (magit-completing-read - prompt - (mapcar (pcase-lambda (`(,host ,owner ,name)) - (format "%s/%s @%s" owner name host)) - (forge-sql [:select [githost owner name] - :from repository])) - nil t nil nil - (and-let* ((default (or (forge-current-repository) - (forge-get-repository nil)))) - (format "%s/%s @%s" - (oref default owner) - (oref default name) - (oref default githost)))))) - (save-match-data - (if (string-match "\\`\\(.+\\)/\\([^/]+\\) @\\(.+\\)\\'" choice) - (list (match-string 3 choice) - (match-string 1 choice) - (match-string 2 choice)) - (error "BUG"))))) - -(defun forge-read-host (prompt &optional class) - (magit-completing-read - prompt - (if class - (-keep (pcase-lambda (`(,githost ,_apihost ,_id ,c)) - (and (child-of-class-p c class) githost)) - forge-alist) - (mapcar #'car forge-alist)) - nil t)) - -(defun forge--as-githost (host) - (or (car (car (cl-member host forge-alist :test #'equal :key #'car))) - (car (car (cl-member host forge-alist :test #'equal :key #'cadr))) - (car (car (cl-member host forge-alist :test #'equal :key #'caddr))) - (user-error "Cannot determine githost for %S" host))) - -(defun forge--as-apihost (host) - (or (cadr (car (cl-member host forge-alist :test #'equal :key #'cadr))) - (cadr (car (cl-member host forge-alist :test #'equal :key #'car))) - (cadr (car (cl-member host forge-alist :test #'equal :key #'caddr))) - (user-error "Cannot determine githost for %S" host))) - -(cl-defmethod forge--topics-until ((repo forge-repository) until table) - (if (oref repo sparse-p) - until - (caar (forge-sql [:select [updated] :from $i1 - :where (= repository $s2) - :order-by [(desc updated)] - :limit 1] - table (oref repo id))))) - -(cl-defmethod forge--format ((repo forge-repository) format-or-slot &optional spec) - (format-spec - (if (symbolp format-or-slot) - (eieio-oref repo format-or-slot) - format-or-slot) - (with-slots (githost owner name) repo - (let ((path (if owner (concat owner "/" name) name))) - `(,@spec - (?h . ,githost) - (?o . ,owner) - (?n . ,name) - (?p . ,path) - (?P . ,(string-replace "/" "%2F" path))))))) - -(cl-defmethod forge-get-url ((repo forge-repository)) - (forge--format (oref repo remote) 'remote-url-format)) - -(defun forge--set-field-callback () - (let ((buf (current-buffer))) - (lambda (&rest _) - (with-current-buffer - (or buf (current-buffer)) - (forge-pull))))) - -(defvar forge--mode-line-buffer nil) - -(defun forge--msg (repo echo done format &rest args) - (let ((msg (apply #'format format args))) - (when repo - (setq msg (string-replace - "REPO" - (concat (oref repo owner) "/" (oref repo name)) - msg))) - (when (and echo msg) - (message "%s%s" msg (if done "...done" "..."))) - (when (buffer-live-p forge--mode-line-buffer) - (with-current-buffer forge--mode-line-buffer - (setq mode-line-process - (if done - nil - (concat " " (propertize msg 'font-lock-face - 'magit-mode-line-process))))) - (force-mode-line-update t)))) - -(cl-defmethod ghub--host ((repo forge-repository)) - (cl-call-next-method (forge--ghub-type-symbol (eieio-object-class repo)))) - -(cl-defmethod ghub--username ((repo forge-repository)) - (let ((sym (forge--ghub-type-symbol (eieio-object-class repo)))) - (cl-call-next-method (ghub--host sym) sym))) - -(defun forge--ghub-type-symbol (class) - (cl-ecase class - ;; This package does not define a `forge-gitlab-http-repository' - ;; class, but we suggest at #9 that users define such a class if - ;; they must connect to a Gitlab instance that uses http instead - ;; of https. - ((forge-gitlab-repository forge-gitlab-http-repository) 'gitlab) - (forge-github-repository 'github) - (forge-gitea-repository 'gitea) - (forge-gogs-repository 'gogs) - (forge-bitbucket-repository 'bitbucket))) - -;;; _ -(provide 'forge-repo) -;;; forge-repo.el ends here diff --git a/elpa/forge-20230505.926/forge-revnote.el b/elpa/forge-20230505.926/forge-revnote.el deleted file mode 100644 index b410f81c..00000000 --- a/elpa/forge-20230505.926/forge-revnote.el +++ /dev/null @@ -1,47 +0,0 @@ -;;; forge-revnote.el --- Revnote support -*- lexical-binding:t -*- - -;; Copyright (C) 2018-2023 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-20230505.926/forge-semi.el b/elpa/forge-20230505.926/forge-semi.el deleted file mode 100644 index dc235adc..00000000 --- a/elpa/forge-20230505.926/forge-semi.el +++ /dev/null @@ -1,81 +0,0 @@ -;;; forge-semi.el --- Support for semi-forges -*- lexical-binding:t -*- - -;; Copyright (C) 2018-2023 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) - -(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-20230505.926/forge-topic.el b/elpa/forge-20230505.926/forge-topic.el deleted file mode 100644 index 26e7e407..00000000 --- a/elpa/forge-20230505.926/forge-topic.el +++ /dev/null @@ -1,977 +0,0 @@ -;;; forge-topic.el --- Topics support -*- lexical-binding:t -*- - -;; Copyright (C) 2018-2023 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 issues") - (cons (number :tag "Maximal number of open issues") - (number :tag "Maximal number of closed issues")))) - -(defcustom forge-post-heading-format "%a %C\n" - "Format for post headings in topic view. - -The following %-sequences are supported: - -`%a' The forge nickname of the author. -`%c' The absolute creation date. -`%C' The relative creation date." - :package-version '(forge . "0.1.0") - :group 'forge - :type 'string) - -(defcustom forge-post-fill-region t - "Whether to call `fill-region' before displaying forge posts." - :package-version '(forge . "0.1.0") - :group 'forge - :type 'boolean) - -(defcustom forge-bug-reference-hooks - '(find-file-hook - forge-post-mode-hook - git-commit-setup-hook - magit-mode-hook) - "Hooks to which `forge-bug-reference-setup' is added. -This variable has to be customized before `forge' is loaded." - :package-version '(forge . "0.2.0") - :group 'forge - :options '(find-file-hook - forge-post-mode-hook - git-commit-setup-hook - magit-mode-hook) - :type '(list :convert-widget custom-hook-convert-widget)) - -(defvar-local forge-display-in-status-buffer t - "Whether to display topics in the current Magit status buffer.") -(put 'forge-display-in-status-buffer 'permanent-local t) - -(defvar forge-format-avatar-function nil - "Function used to insert avatars in certain locations. -This is experimental and intended for users who wish to -implement such a function themselves. See #447.") - -;;; Faces - -(defface forge-topic-unread - '((t :inherit bold)) - "Face used for title of unread topics." - :group 'forge-faces) - -(defface forge-topic-closed - '((t :inherit magit-dimmed)) - "Face used for title of closed topics." - :group 'forge-faces) - -(defface forge-topic-open - '((t :inherit default)) - "Face used for title of open topics." - :group 'forge-faces) - -(defface forge-topic-merged - '((t :inherit magit-dimmed)) - "Face used for number of merged pull-requests." - :group 'forge-faces) - -(defface forge-topic-unmerged - '((t :inherit magit-dimmed :slant italic)) - "Face used for number of unmerged pull-requests." - :group 'forge-faces) - -(defface forge-topic-label - `((t :box ( :line-width ,(if (>= emacs-major-version 28) (cons -1 -1) -1) - :style released-button))) - "Face used for topic labels." - :group 'forge-faces) - -(defface forge-post-author - '((t :inherit bold)) - "Face used for post author in topic view." - :group 'forge-faces) - -(defface forge-post-date - '((t :inherit italic)) - "Face used for post date in topic view." - :group 'forge-faces) - -;;; Class - -(defclass forge-topic (forge-post) () :abstract t) - -(cl-defmethod forge--object-id ((class (subclass forge-topic)) repo number) - "Return the id for a CLASS object in REPO identified by id NUMBER." - (base64-encode-string - (encode-coding-string - (format "%s:%s%s" - (base64-decode-string (oref repo id)) - (substring (symbol-name class) - (length (oref-default class closql-class-prefix))) - number) - 'utf-8) - t)) - -(cl-defmethod forge--object-id ((prefix string) number-or-id) - (base64-encode-string - (encode-coding-string - (format "%s:%s" - (base64-decode-string prefix) - (if (numberp number-or-id) - number-or-id - ;; Currently every id is base64 encode. Unfortunately - ;; we cannot use the ids of Gitlab labels (see comment - ;; in the respective `forge--update-labels' method), - ;; and have to use their names, which are not encoded. - (or (ignore-errors (base64-decode-string number-or-id)) - number-or-id))) - 'utf-8) - t)) - -;;; Query - -(cl-defmethod forge-get-parent ((topic forge-topic)) - (forge-get-repository topic)) - -(cl-defmethod forge-get-repository ((topic forge-topic)) - (closql-get (forge-db) - (oref topic repository) - 'forge-repository)) - -(cl-defmethod forge-get-topic ((topic forge-topic)) - topic) - -(cl-defmethod forge-get-topic ((repo forge-repository) number-or-id) - (if (numberp number-or-id) - (if (< number-or-id 0) - (forge-get-pullreq repo (abs number-or-id)) - (or (forge-get-issue repo number-or-id) - (forge-get-pullreq repo number-or-id))) - (or (forge-get-issue number-or-id) - (forge-get-pullreq number-or-id)))) - -(cl-defmethod forge-get-topic ((number integer)) - (if (< number 0) - (forge-get-pullreq (abs number)) - (or (forge-get-issue number) - (forge-get-pullreq number)))) - -(cl-defmethod forge-get-topic ((id string)) - (or (forge-get-issue id) - (forge-get-pullreq id))) - -(cl-defmethod forge-ls-recent-topics ((repo forge-repository) table) - (magit--with-repository-local-cache (list 'forge-ls-recent-topics table) - (let* ((id (oref repo id)) - (limit forge-topic-list-limit) - (open-limit (if (consp limit) (car limit) limit)) - (closed-limit (if (consp limit) (cdr limit) limit)) - (topics (forge-sql [:select * :from $i1 - :where (and (= repository $s2) - (notnull unread-p))] - table id))) - (mapc (lambda (row) - (cl-pushnew row topics :test #'equal)) - (if (consp limit) - (forge-sql [:select * :from $i1 - :where (and (= repository $s2) - (isnull closed)) - :order-by [(desc updated)] - :limit $s3] - table id open-limit) - (forge-sql [:select * :from $i1 - :where (and (= repository $s2) - (isnull closed))] - table id))) - (when (> closed-limit 0) - (mapc (lambda (row) - (cl-pushnew row topics :test #'equal)) - (forge-sql [:select * :from $i1 - :where (and (= repository $s2) - (notnull closed)) - :order-by [(desc updated)] - :limit $s3] - table id closed-limit))) - (cl-sort (mapcar (let ((class (if (eq table 'pullreq) - 'forge-pullreq - 'forge-issue))) - (lambda (row) - (closql--remake-instance class (forge-db) row))) - topics) - (cdr forge-topic-list-order) - :key (lambda (it) (eieio-oref it (car forge-topic-list-order))))))) - -(cl-defmethod forge-ls-topics ((repo forge-repository) - class &optional type select) - (let* ((table (oref-default class closql-table)) - (id (oref repo id)) - (rows (pcase-exhaustive type - (`open (forge-sql [:select $i1 :from $i2 - :where (and (= repository $s3) - (isnull closed)) - :order-by [(desc number)]] - (or select '*) table id)) - (`closed (forge-sql [:select $i1 :from $i2 - :where (and (= repository $s3) - (notnull closed)) - :order-by [(desc number)]] - (or select '*) table id)) - (`nil (forge-sql [:select $i1 :from $i2 - :where (= repository $s3) - :order-by [(desc number)]] - (or select '*) table id))))) - (if select - rows - (mapcar (lambda (row) - (closql--remake-instance class (forge-db) row)) - rows)))) - -;;; Utilities - -(cl-defmethod forge--format ((topic forge-topic) slot &optional spec) - (forge--format (forge-get-repository topic) slot - `(,@spec (?i . ,(oref topic number))))) - -(cl-defmethod forge-visit ((topic forge-topic)) - (forge-topic-setup-buffer topic) - (forge-topic-mark-read (forge-get-repository topic) topic)) - -(cl-defmethod forge-topic-mark-read ((_ forge-repository) topic) - (oset topic unread-p nil)) - -(defun forge--sanitize-string (string) - ;; For Gitlab this may also be nil. - (if string (string-replace "\r\n" "\n" string) "")) - -(defun forge-insert-topics (heading topics prefix) - "Under a new section with HEADING, insert TOPICS." - (when topics - (let ((width (apply #'max - (--map (length (number-to-string (oref it number))) - topics))) - list-section-type topic-section-type) - (cond ((forge--childp (car topics) 'forge-issue) - (setq list-section-type 'issues) - (setq topic-section-type 'issue)) - ((forge--childp (car topics) 'forge-pullreq) - (setq list-section-type 'pullreqs) - (setq topic-section-type 'pullreq))) - (magit-insert-section ((eval list-section-type) nil t) - (magit-insert-heading - (concat (magit--propertize-face (concat heading " ") - 'magit-section-heading) - (magit--propertize-face (format "(%s)" (length topics)) - 'magit-section-child-count))) - (magit-make-margin-overlay nil t) - (magit-insert-section-body - (dolist (topic topics) - (forge-insert-topic topic topic-section-type width prefix)) - (insert ?\n) - (magit-make-margin-overlay nil t)))))) - -(defun forge-insert-topic (topic &optional topic-section-type width prefix) - "Insert TOPIC as a new section. -If TOPIC-SECTION-TYPE is provided, it is the section type to use. -If WIDTH is provided, it is a fixed width to use for the topic -identifier." - (unless topic-section-type - (setq topic-section-type - (cond ((forge--childp topic 'forge-issue) 'issue) - ((forge--childp topic 'forge-pullreq) 'pullreq)))) - (magit-insert-section ((eval topic-section-type) topic t) - (forge--insert-topic-contents topic width prefix))) - -(cl-defmethod forge--format-topic-id ((topic forge-topic) &optional prefix) - (propertize (format "%s%s" - (or prefix (forge--topic-type-prefix topic)) - (oref topic number)) - 'font-lock-face 'magit-dimmed)) - -(cl-defmethod forge--insert-topic-contents ((topic forge-topic) width prefix) - (with-slots (number title unread-p closed) topic - (insert (format (if width (format "%%-%is" (1+ width)) "%s") - (forge--format-topic-id topic prefix))) - (forge--insert-topic-marks topic) - (insert " ") - (insert (magit-log-propertize-keywords - nil (propertize title 'font-lock-face - (cond (unread-p 'forge-topic-unread) - (closed 'forge-topic-closed) - (t 'forge-topic-open))))) - (forge--insert-topic-labels topic) - (insert "\n") - (magit-log-format-author-margin - (oref topic author) - (format-time-string "%s" (parse-iso8601-time-string (oref topic created))) - t))) - -(defun forge--topic-by-forge-short-link-at-point (known-prefixes finder) - "Finds a topic by forge-dependant short link around point. -The topic number is expected to be a number prefixed by any of -the elements in KNOWN-PREFIXES. If a reference is found, FINDER -is called and a topic object is returned if available." - (and-let* ((number (number-at-point)) - (prefix (buffer-substring-no-properties - (- (match-beginning 0) 1) - (match-beginning 0)))) - (and (member prefix known-prefixes) - (funcall finder number)))) - -;;; Mode - -(defvar-keymap forge-topic-mode-map - "C-c C-n" #'forge-create-post - "C-c C-r" #'forge-create-post - " " #'forge-browse-topic - " " #'markdown-follow-link-at-point - "" #'markdown-follow-link-at-point) - -(define-derived-mode forge-topic-mode magit-mode "View Topic" - "View a forge issue or pull-request." - (setq-local markdown-translate-filename-function - #'forge--markdown-translate-filename-function)) - -(defvar forge-topic-headers-hook - '(forge-insert-topic-title - forge-insert-topic-state - forge-insert-topic-draft - forge-insert-topic-refs - forge-insert-topic-milestone - forge-insert-topic-labels - forge-insert-topic-marks - forge-insert-topic-assignees - forge-insert-topic-review-requests)) - -(defvar-keymap forge-post-section-map - " " #'forge-browse-post - " " #'forge-edit-post - "C-c C-k" #'forge-delete-comment) - -(defvar-local forge-buffer-topic nil) -(defvar-local forge-buffer-topic-ident nil) - -(defun forge-topic-setup-buffer (topic) - (let* ((repo (forge-get-repository topic)) - (ident (concat (forge--topic-type-prefix topic) - (number-to-string (oref topic number)))) - (name (format "*forge: %s/%s %s*" - (oref repo owner) - (oref repo name) - ident)) - (magit-generate-buffer-name-function (lambda (_mode _value) name)) - (current-repo (forge-get-repository nil)) - (default-directory (if (and current-repo - (eq (oref current-repo id) - (oref repo id))) - default-directory - (or (oref repo worktree) - default-directory)))) - (magit-setup-buffer #'forge-topic-mode t - (forge-buffer-topic topic) - (forge-buffer-topic-ident ident)))) - -(defun forge-topic-refresh-buffer () - (let ((topic (closql-reload forge-buffer-topic))) - (setq forge-buffer-topic topic) - (magit-set-header-line-format - (format "%s: %s" forge-buffer-topic-ident (oref topic title))) - (magit-insert-section (topicbuf) - (magit-insert-headers 'forge-topic-headers-hook) - (when (forge-pullreq-p topic) - (magit-insert-section (pullreq topic) - (magit-insert-heading "Commits") - (forge--insert-pullreq-commits topic t))) - (when-let ((note (oref topic note))) - (magit-insert-section (note) - (magit-insert-heading "Note") - (insert (forge--fontify-markdown note) "\n\n"))) - (dolist (post (cons topic (oref topic posts))) - (with-slots (author created body) post - (magit-insert-section section (post post) - (oset section heading-highlight-face - 'magit-diff-hunk-heading-highlight) - (let ((heading - (format-spec - forge-post-heading-format - `((?a . ,(propertize (concat (forge--format-avatar author) - (or author "(ghost)")) - 'font-lock-face 'forge-post-author)) - (?c . ,(propertize created 'font-lock-face 'forge-post-date)) - (?C . ,(propertize (apply #'format "%s %s ago" - (magit--age - (float-time - (date-to-time created)))) - 'font-lock-face 'forge-post-date)))))) - (font-lock-append-text-property - 0 (length heading) - 'font-lock-face 'magit-diff-hunk-heading heading) - (magit-insert-heading heading)) - (insert (forge--fontify-markdown body) "\n\n")))) - (when (and (display-images-p) - (fboundp 'markdown-display-inline-images)) - (let ((markdown-display-remote-images t)) - (markdown-display-inline-images)))))) - -(cl-defmethod magit-buffer-value (&context (major-mode forge-topic-mode)) - forge-buffer-topic-ident) - -(defvar-keymap forge-topic-title-section-map - " " #'forge-edit-topic-title) - -(cl-defun forge-insert-topic-title - (&optional (topic forge-buffer-topic)) - (magit-insert-section (topic-title) - (insert (format "%-11s" "Title: ") (oref topic title) "\n"))) - -(defvar-keymap forge-topic-state-section-map - " " #'forge-edit-topic-state) - -(cl-defun forge-insert-topic-state - (&optional (topic forge-buffer-topic)) - (magit-insert-section (topic-state) - (insert (format - "%-11s%s\n" "State: " - (let ((state (oref topic state))) - (magit--propertize-face - (symbol-name state) - (pcase (list state (forge-pullreq-p (forge-topic-at-point))) - ('(merged) 'forge-topic-merged) - ('(closed) 'forge-topic-closed) - ('(open t) 'forge-topic-unmerged) - ('(open) 'forge-topic-open)))))))) - -(defvar-keymap forge-topic-draft-section-map - " " #'forge-edit-topic-draft) - -(cl-defun forge-insert-topic-draft - (&optional (topic forge-buffer-topic)) - (when (forge-pullreq-p topic) - (magit-insert-section (topic-draft) - (insert (format "%-11s%s\n" "Draft: " (oref topic draft-p)))))) - -(defvar-keymap forge-topic-milestone-section-map - " " #'forge-edit-topic-milestone) - -(cl-defun forge-insert-topic-milestone - (&optional (topic forge-buffer-topic)) - (magit-insert-section (topic-milestone) - (insert (format "%-11s" "Milestone: ") - (or (forge--get-topic-milestone topic) - ;; If the user hasn't pulled this repository yet after - ;; updating to db v7, then only the id is available. - (oref topic milestone) - (propertize "none" 'font-lock-face 'magit-dimmed)) - "\n"))) - -(defun forge--get-topic-milestone (topic) - (and-let* ((id (oref topic milestone))) - (caar (forge-sql [:select [title] :from milestone :where (= id $s1)] id)))) - -(defvar-keymap forge-topic-labels-section-map - " " #'forge-edit-topic-labels) - -(cl-defun forge-insert-topic-labels - (&optional (topic forge-buffer-topic)) - (magit-insert-section (topic-labels) - (insert (format "%-11s" "Labels: ")) - (if-let ((labels (closql--iref topic 'labels))) - (forge--insert-topic-labels topic t labels) - (insert (propertize "none" 'font-lock-face 'magit-dimmed))) - (insert ?\n))) - -(defun forge--format-topic-labels (topic) - (and-let* ((labels (closql--iref topic 'labels))) - (mapconcat (pcase-lambda (`(,name ,color ,_desc)) - (propertize name 'font-lock-face (list :box color))) - labels " "))) - -(defun forge--insert-topic-labels (topic &optional skip-separator labels) - (pcase-dolist (`(,name ,color ,description) - (or labels (closql--iref topic 'labels))) - (if skip-separator - (setq skip-separator nil) - (insert " ")) - (let* ((background (forge--sanitize-color color)) - (foreground (forge--contrast-color background))) - (insert name) - (let ((o (make-overlay (- (point) (length name)) (point)))) - (overlay-put o 'priority 2) - (overlay-put o 'evaporate t) - (overlay-put o 'font-lock-face - `(( :background ,background - :foreground ,foreground) - forge-topic-label)) - (when description - (overlay-put o 'help-echo description)))))) - -(defvar-keymap forge-topic-marks-section-map - " " #'forge-edit-topic-marks) - -(cl-defun forge-insert-topic-marks - (&optional (topic forge-buffer-topic)) - (magit-insert-section (topic-marks) - (insert (format "%-11s" "Marks: ")) - (if-let ((marks (closql--iref topic 'marks))) - (forge--insert-topic-marks topic t marks) - (insert (propertize "none" 'font-lock-face 'magit-dimmed))) - (insert ?\n))) - -(defun forge--insert-topic-marks (topic &optional skip-separator marks) - (pcase-dolist (`(,name ,face ,description) - (or marks (closql--iref topic 'marks))) - (if skip-separator - (setq skip-separator nil) - (insert " ")) - (insert name) - (let ((o (make-overlay (- (point) (length name)) (point)))) - (overlay-put o 'priority 2) - (overlay-put o 'evaporate t) - (overlay-put o 'font-lock-face (list face 'forge-topic-label)) - (when description - (overlay-put o 'help-echo description))))) - -(defun forge--sanitize-color (color) - (cond ((x-color-values color) color) - ;; Discard alpha information. - ((string-match-p "\\`#.\\{4\\}\\'" color) (substring color 0 3)) - ((string-match-p "\\`#.\\{8\\}\\'" color) (substring color 0 6)) - (t "#000000"))) ; Use fallback instead of invalid color. - -(defun forge--contrast-color (color) - "Return black or white depending on the luminance of COLOR." - (if (> (forge--x-color-luminance color) 0.5) "black" "white")) - -;; Copy of `rainbow-x-color-luminance'. -(defun forge--x-color-luminance (color) - "Calculate the luminance of a color string (e.g. \"#ffaa00\", \"blue\"). -Return a value between 0 and 1." - (let ((values (x-color-values color))) - (forge--color-luminance (/ (nth 0 values) 256.0) - (/ (nth 1 values) 256.0) - (/ (nth 2 values) 256.0)))) - -;; Copy of `rainbow-color-luminance'. -;; Also see https://en.wikipedia.org/wiki/Relative_luminance. -(defun forge--color-luminance (red green blue) - "Calculate the luminance of color composed of RED, GREEN and BLUE. -Return a value between 0 and 1." - (/ (+ (* .2126 red) (* .7152 green) (* .0722 blue)) 256)) - -(cl-defun forge-insert-topic-refs - (&optional (topic forge-buffer-topic)) - (when (forge-pullreq-p topic) - (magit-insert-section (topic-refs) - (with-slots (cross-repo-p base-repo base-ref head-repo head-ref) topic - (let ((separator (propertize ":" 'font-lock-face 'magit-dimmed)) - (deleted (propertize "(deleted)" 'font-lock-face 'magit-dimmed))) - (insert (format "%-11s" "Refs: ") - (if cross-repo-p - (concat base-repo separator base-ref) - base-ref) - (propertize "..." 'font-lock-face 'magit-dimmed) - (if cross-repo-p - (if (and head-repo head-ref) - (concat head-repo separator head-ref) - deleted) - (or head-ref deleted)) - "\n")))))) - -(defvar-keymap forge-topic-assignees-section-map - " " #'forge-edit-topic-assignees) - -(cl-defun forge-insert-topic-assignees - (&optional (topic forge-buffer-topic)) - (magit-insert-section (topic-assignees) - (insert (format "%-11s" "Assignees: ")) - (if-let ((assignees (closql--iref topic 'assignees))) - (insert (mapconcat (pcase-lambda (`(,login ,name)) - (format "%s%s (@%s)" - (forge--format-avatar login) - name login)) - assignees ", ")) - (insert (propertize "none" 'font-lock-face 'magit-dimmed))) - (insert ?\n))) - -(defvar-keymap forge-topic-review-requests-section-map - " " #'forge-edit-topic-review-requests) - -(cl-defun forge-insert-topic-review-requests - (&optional (topic forge-buffer-topic)) - (when (forge-pullreq-p topic) - (magit-insert-section (topic-review-requests) - (insert (format "%-11s" "Review-Requests: ")) - (if-let ((review-requests (closql--iref topic 'review-requests))) - (insert (mapconcat (pcase-lambda (`(,login ,name)) - (format "%s%s (@%s)" - (forge--format-avatar login) - name login)) - review-requests ", ")) - (insert (propertize "none" 'font-lock-face 'magit-dimmed))) - (insert ?\n)))) - -(defun forge--fontify-markdown (text) - (with-temp-buffer - (delay-mode-hooks - (gfm-mode)) - (insert text) - (font-lock-ensure) - (when forge-post-fill-region - (fill-region (point-min) (point-max))) - (buffer-string))) - -(cl-defmethod forge--topic-type-prefix ((_ forge-topic)) - "Get the identifier prefix specific to the type of TOPIC." - "#") - -(cl-defmethod forge--topic-type-prefix ((_repo forge-repository) _type) - "#") - -(defun forge--markdown-translate-filename-function (file) - (if (string-match-p "\\`https?://" file) - file - (let ((host (oref (forge-get-repository t) githost))) - (concat (if (member host ghub-insecure-hosts) "http://" "https://") - host - (and (not (string-prefix-p "/" file)) "/") - file)))) - -(defun forge--format-avatar (author) - (if forge-format-avatar-function - (funcall forge-format-avatar-function author) - "")) - -;;; Completion - -(defun forge-read-topic (prompt &optional type allow-number) - (when (eq type t) - (setq type (if current-prefix-arg nil 'open))) - (let* ((default (forge-current-topic)) - (repo (forge-get-repository (or default t))) - (choices (mapcar - (apply-partially #'forge--topic-format-choice repo) - (cl-sort - (nconc - (forge-ls-pullreqs repo type [number title id class]) - (forge-ls-issues repo type [number title id class])) - #'> :key #'car))) - (choice (magit-completing-read - prompt choices nil nil nil nil - (and default - (setq default (forge--topic-format-choice default)) - (member default choices) - (car default))))) - (or (cdr (assoc choice choices)) - (and allow-number - (let ((number (string-to-number choice))) - (if (= number 0) - (user-error "Not an existing topic or number: %s") - number)))))) - -(cl-defmethod forge--topic-format-choice ((topic forge-topic)) - (cons (format "%s%s %s" - (forge--topic-type-prefix topic) - (oref topic number) - (oref topic title)) - (oref topic id))) - -(cl-defmethod forge--topic-format-choice ((repo forge-repository) args) - (pcase-let ((`(,number ,title ,id ,class) args)) - (cons (format "%s%s %s" - (forge--topic-type-prefix repo class) - number - title) - id))) - -(defun forge-topic-completion-at-point () - (let ((bol (line-beginning-position)) - repo) - (and (looking-back "[!#][0-9]*" bol) - (or (not bug-reference-prog-mode) - (nth 8 (syntax-ppss))) ; inside comment or string - (setq repo (forge-get-repository t)) - (looking-back (if (forge--childp repo 'forge-gitlab-repository) - "\\(?3:[!#]\\)\\(?2:[0-9]*\\)" - "#\\(?2:[0-9]*\\)") - bol) - (list (match-beginning 2) - (match-end 0) - (mapcar (lambda (row) - (propertize (number-to-string (car row)) - :title (format " %s" (cadr row)))) - (if (forge--childp repo 'forge-gitlab-repository) - (forge-sql [:select [number title] - :from $i1 - :where (= repository $s2) - :order-by [(desc updated)]] - (if (equal (match-string 3) "#") - 'issue - 'pullreq) - (oref repo id)) - (forge-sql [:select [number title updated] - :from pullreq - :where (= repository $s1) - :union - :select [number title updated] - :from issue - :where (= repository $s1) - :order-by [(desc updated)]] - (oref repo id)))) - :annotation-function (lambda (c) (get-text-property 0 :title c)))))) - -;;; Parse - -(defun forge--topic-parse-buffer (&optional file) - (save-match-data - (save-excursion - (goto-char (point-min)) - (let ((alist (save-excursion (forge--topic-parse-yaml)))) - (if alist - (setf (alist-get 'yaml alist) t) - (setq alist (save-excursion (forge--topic-parse-plain)))) - (setf (alist-get 'file alist) file) - (setf (alist-get 'text alist) (magit--buffer-string nil nil ?\n)) - (when (and file (not (alist-get 'prompt alist))) - (setf (alist-get 'prompt alist) - (file-name-sans-extension (file-name-nondirectory file)))) - ;; If there is a yaml front-matter, then it is supposed - ;; to have a `title' field, but this may not be the case. - (when (and (not file) - (not (alist-get 'title alist))) - (setf (alist-get 'title alist) - (read-string "Title: "))) - alist)))) - -(defun forge--topic-parse-yaml () - (let (alist beg end) - (when (looking-at "^---[\s\t]*$") - (forward-line) - (setq beg (point)) - (when (re-search-forward "^---[\s\t]*$" nil t) - (setq end (match-beginning 0)) - (setq alist (yaml-parse-string - (buffer-substring-no-properties beg end) - :object-type 'alist - :sequence-type 'list - ;; FIXME Does not work because of - ;; https://github.com/zkry/yaml.el/pull/28. - :false-object nil)) - (let-alist alist - (when (and .name .about) - (setf (alist-get 'prompt alist) - (format "[%s] %s" .name .about))) - (when (and .labels (atom .labels)) - (setf (alist-get 'labels alist) (list .labels))) - (when (and .assignees (atom .assignees)) - (setf (alist-get 'assignees alist) (list .assignees)))) - (forward-line) - (when (and (not (alist-get 'title alist)) - (looking-at "^\n?#*")) - (goto-char (match-end 0)) - (setf (alist-get 'title alist) - (string-trim - (magit--buffer-string (point) (line-end-position) t))) - (forward-line)) - (setf (alist-get 'body alist) - (string-trim (magit--buffer-string (point) nil ?\n))))) - alist)) - -(defun forge--topic-parse-plain () - (let (title body) - (when (looking-at "\\`#*") - (goto-char (match-end 0))) - (setq title (magit--buffer-string (point) (line-end-position) t)) - (forward-line) - (setq body (magit--buffer-string (point) nil ?\n)) - `((title . ,(string-trim title)) - (body . ,(string-trim body))))) - -(defun forge--topic-parse-link-buffer () - (save-match-data - (save-excursion - (goto-char (point-min)) - (mapcar (lambda (alist) - (cons (cons 'prompt (concat (alist-get 'name alist) " -- " - (alist-get 'about alist))) - alist)) - (forge--topic-parse-yaml-links))))) - -(defun forge--topic-parse-yaml-links () - (alist-get 'contact_links - (yaml-parse-string (buffer-substring-no-properties - (point-min) - (point-max)) - :object-type 'alist - :sequence-type 'list))) - -;;; Templates - -(cl-defgeneric forge--topic-templates (repo class) - "Return a list of topic template files for REPO and a topic of CLASS.") - -(cl-defgeneric forge--topic-template (repo class) - "Return a topic template alist for REPO and a topic of CLASS. -If there are multiple templates, then the user is asked to select -one of them. It there are no templates, then return a very basic -alist, containing just `text' and `position'.") - -(defun forge--topic-templates-data (repo class) - (let ((branch (oref repo default-branch))) - (mapcan (lambda (f) - (with-temp-buffer - (magit-git-insert "cat-file" "-p" (concat branch ":" f)) - (if (equal (file-name-nondirectory f) "config.yml") - (forge--topic-parse-link-buffer) - (list (forge--topic-parse-buffer f))))) - (forge--topic-templates repo class)))) - -(cl-defmethod forge--topic-template ((repo forge-repository) - (class (subclass forge-topic))) - (let ((choices (forge--topic-templates-data repo class))) - (if (cdr choices) - (let ((c (magit-completing-read - (if (eq class 'forge-pullreq) - "Select pull-request template" - "Select issue template") - (--map (alist-get 'prompt it) choices) - nil t))) - (--first (equal (alist-get 'prompt it) c) choices)) - (car choices)))) - -;;; Bug-Reference - -(when (< emacs-major-version 28) - (defun bug-reference-fontify (start end) - "Apply bug reference overlays to region." - (save-excursion - (let ((beg-line (progn (goto-char start) (line-beginning-position))) - (end-line (progn (goto-char end) (line-end-position)))) - ;; Remove old overlays. - (bug-reference-unfontify beg-line end-line) - (goto-char beg-line) - (while (and (< (point) end-line) - (re-search-forward bug-reference-bug-regexp end-line 'move)) - (when (and (or (not bug-reference-prog-mode) - ;; This tests for both comment and string syntax. - (nth 8 (syntax-ppss))) - ;; This is the part where this redefinition differs - ;; from the original defined in "bug-reference.el". - (not (and (derived-mode-p 'magit-status-mode - 'forge-notifications-mode) - (= (match-beginning 0) - (line-beginning-position)))) - ;; End of additions. - ) - (let ((overlay (make-overlay (match-beginning 0) (match-end 0) - nil t nil))) - (overlay-put overlay 'category 'bug-reference) - ;; Don't put a link if format is undefined - (when bug-reference-url-format - (overlay-put overlay 'bug-reference-url - (if (stringp bug-reference-url-format) - (format bug-reference-url-format - (match-string-no-properties 2)) - (funcall bug-reference-url-format))))))))))) - -(defun forge-bug-reference-setup () - "Setup `bug-reference' in the current buffer. -If forge data has been fetched for the current repository, then -enable `bug-reference-mode' or `bug-reference-prog-mode' and -modify `bug-reference-bug-regexp' if appropriate." - (unless (or bug-reference-url-format - (not (forge-db t))) - (magit--with-safe-default-directory nil - (when-let ((repo (forge-get-repository 'full))) - (if (>= emacs-major-version 28) - (when (derived-mode-p 'magit-status-mode - 'forge-notifications-mode) - (setq-local - bug-reference-auto-setup-functions - (let ((hook bug-reference-auto-setup-functions)) - (list (lambda () - ;; HOOK is not allowed to be a lexical var: - ;; (run-hook-with-args-until-success 'hook) - (catch 'success - (dolist (f hook) - (when (funcall f) - (setq bug-reference-bug-regexp - (concat "." bug-reference-bug-regexp)) - (throw 'success t))))))))) - (setq-local bug-reference-url-format - (if (forge--childp repo 'forge-gitlab-repository) - (lambda () - (forge--format repo - (if (equal (match-string 3) "#") - 'issue-url-format - 'pullreq-url-format) - `((?i . ,(match-string 2))))) - (forge--format repo 'issue-url-format '((?i . "%s"))))) - (setq-local bug-reference-bug-regexp - (if (forge--childp repo 'forge-gitlab-repository) - "\\(?3:[!#]\\)\\(?2:[0-9]+\\)" - "#\\(?2:[0-9]+\\)"))) - (if (derived-mode-p 'prog-mode) - (bug-reference-prog-mode 1) - (bug-reference-mode 1)) - (add-hook 'completion-at-point-functions - #'forge-topic-completion-at-point nil t))))) - -(unless noninteractive - (dolist (hook forge-bug-reference-hooks) - (add-hook hook #'forge-bug-reference-setup))) - -;;; _ -(provide 'forge-topic) -;;; forge-topic.el ends here diff --git a/elpa/forge-20230505.926/forge.el b/elpa/forge-20230505.926/forge.el deleted file mode 100644 index 592f055f..00000000 --- a/elpa/forge-20230505.926/forge.el +++ /dev/null @@ -1,169 +0,0 @@ -;;; forge.el --- Access Git forges from Magit -*- lexical-binding:t -*- - -;; Copyright (C) 2018-2023 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-list) - -;;; Add Sections - -(defvar forge-add-default-sections t - "Whether to add Forge's sections to `magit-status-sections-hook'. -If you want to disable this, then you must set this to nil before -`forge' is loaded.") - -(when forge-add-default-sections - (magit-add-section-hook 'magit-status-sections-hook #'forge-insert-pullreqs nil t) - (magit-add-section-hook 'magit-status-sections-hook #'forge-insert-issues nil t)) - -;;; Add Bindings - -;;;###autoload -(defvar forge-add-default-bindings t - "Whether to add Forge's bindings to various Magit keymaps. - -If you want to disable this, then you must set this to nil before -`magit' is loaded. If you do it before `forge' but after `magit' -is loaded, then `magit-mode-map' ends up being modified anyway. - -If this is nil, then `forge-toggle-display-in-status-buffer' can -no longer do its job. It might be better to set the global value -of `forge-display-in-status-buffer' to nil instead. That way you -can still display topics on demand in the status buffer.") - -;;;###autoload -(with-eval-after-load 'git-commit - (when forge-add-default-bindings - (define-key git-commit-mode-map (kbd "C-c C-v") #'forge-visit-topic))) - -;;;###autoload -(with-eval-after-load 'magit-mode - (when forge-add-default-bindings - (define-key magit-mode-map "'" #'forge-dispatch) - (define-key magit-mode-map "N" #'forge-dispatch))) - -(when forge-add-default-bindings - (define-key magit-commit-section-map [remap magit-browse-thing] #'forge-browse-dwim) - (define-key magit-remote-section-map [remap magit-browse-thing] #'forge-browse-remote) - (define-key magit-branch-section-map [remap magit-browse-thing] #'forge-browse-branch) - - (define-key magit-commit-section-map (kbd "C-c C-v") #'forge-visit-topic) - (define-key magit-branch-section-map (kbd "C-c C-v") #'forge-visit-topic) - - (transient-insert-suffix 'magit-dispatch "o" - '("N" "Forge" forge-dispatch)) - - (transient-append-suffix 'magit-fetch "m" - '("n" "forge topics" forge-pull)) - (transient-append-suffix 'magit-fetch "n" - '("N" "forge notifications" forge-pull-notifications)) - - (transient-append-suffix 'magit-pull "m" - '("n" "forge topics" forge-pull)) - (transient-append-suffix 'magit-pull "n" - '("N" "forge notifications" forge-pull-notifications)) - - (transient-append-suffix 'magit-branch "w" - '("f" "pull-request" forge-checkout-pullreq)) - (transient-append-suffix 'magit-branch "W" - '("F" "from pull-request" forge-branch-pullreq)) - - (transient-suffix-put 'magit-remote 'magit-update-default-branch :key "b u") - (transient-append-suffix 'magit-remote "b u" - '("b r" "Rename default branch" forge-rename-default-branch)) - - (transient-append-suffix 'magit-worktree "c" - '("n" "pull-request worktree" forge-checkout-worktree)) - - (transient-append-suffix 'magit-status-jump "w" - '("Np" "Pull requests" forge-jump-to-pullreqs)) - (transient-append-suffix 'magit-status-jump "Np" - '("Ni" "Issues" forge-jump-to-issues)) - - (transient-append-suffix 'magit-merge "a" - '(7 "M" "Merge using API" forge-merge))) - -;;; Startup Asserts - -(defconst forge--minimal-git "2.7.0") - -(defun forge-startup-asserts () - (let ((version (magit-git-version))) - (when (and version - (version< version forge--minimal-git) - (not (equal (getenv "TRAVIS") "true"))) - (display-warning 'magit (format "\ -Forge requires Git >= %s, you are using %s. - -If this comes as a surprise to you, because you do actually have -a newer version installed, then that probably means that the -older version happens to appear earlier on the `$PATH'. If you -always start Emacs from a shell, then that can be fixed in the -shell's init file. If you start Emacs by clicking on an icon, -or using some sort of application launcher, then you probably -have to adjust the environment as seen by graphical interface. -For X11 something like ~/.xinitrc should work. - -If you use Tramp to work inside remote Git repositories, then you -have to make sure a suitable Git is used on the remote machines -too.\n" forge--minimal-git version) :error)))) - -(if after-init-time - (forge-startup-asserts) - (add-hook 'after-init-hook #'forge-startup-asserts t)) - -;;; forge.el ends here diff --git a/elpa/forge-20230505.926/forge.info b/elpa/forge-20230505.926/forge.info deleted file mode 100644 index 3e7e302e..00000000 --- a/elpa/forge-20230505.926/forge.info +++ /dev/null @@ -1,1504 +0,0 @@ -This is forge.info, produced by makeinfo version 6.7 from forge.texi. - - Copyright (C) 2018-2023 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-2023 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’. - - 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’. - - -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 N’ (‘forge-branch-pullreq’) - This command creates and configures a new branch from a - pull-request, creating and configuring a new remote if necessary. - - The name of the local branch is the same as the name of the remote - branch that you are being asked to merge, unless the contributor - could not be bothered to properly name the branch before opening - the pull-request. The most likely such case is when you are being - asked to merge something like "fork/master" into "origin/master". - In such cases the local branch will be named "pr-N", where ‘N’ is - the pull-request number. - - These variables are always set by this command: - - • ‘branch..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 n’ (‘forge-checkout-pullreq’) - This command creates and configures a new branch from a - pull-request the same way ‘forge-branch-pullreq’ does. - Additionally it checks out the new branch. - -‘Z n’ (‘forge-checkout-worktree’) - This command creates and configures a new branch from a - pull-request the same way ‘forge-branch-pullreq’ does. - Additionally it checks out the new branch using a new working tree. - -User Options: forge-checkout-worktree-read-directory-function - This function is used by ‘forge-checkout-worktree’ to read read the - new worktree directory where it checks out to pull-request. It - takes the pull-request as the only argument and must return a - directory. - - When you delete a pull-request branch, which was created using one of -the above three commands, then ‘magit-branch-delete’ usually offers to -also delete the corresponding remote. It does not offer to delete a -remote if (1) the remote is the upstream remote, and/or (2) if other -branches are being fetched from the remote. - - Note that you have to delete the local branch (e.g. "feature") for -this to work. If you delete the tracking branch (e.g "fork/feature"), -then the remote is never removed. - - -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 two functions to -‘magit-status-sections-hook’: - - -- Function: forge-insert-pullreqs - This function inserts a list of the most recent and/or open - pull-requests. - - -- Function: forge-insert-issues - This function inserts a list of the most recent and/or open issues. - - -- User Option: forge-topic-list-limit - This option limits the number of topics listed by the above - functions. - - All unread topics are always shown. If the value of this option - has the form ‘(OPEN . CLOSED)’, then the integer ‘OPEN’ specifies - the maximal number of topics and ‘CLOSED’ specifies the maximal - number of closed topics. IF ‘CLOSED’ is negative then show no - closed topics until the command ‘forge-toggle-closed-visibility’ - changes the sign. - - -- Command: forge-toggle-closed-visibility - This command toggles whether the above two functions list recently - closed issues in the current buffer. - - The following three functions are also suitable for -‘magit-status-sections-hook’: - - -- Function: forge-insert-assigned-pullreqs - This function inserts a list of open pull-requests that are - assigned to you. - - -- Function: forge-insert-requested-reviews - This function inserts a list of open pull-requests that are - awaiting your review. - - -- Function: forge-insert-authored-pullreqs - This function inserts a list of open pull-requests that are - authored by you. - - -- Function: forge-insert-assigned-issues - This function inserts a list of open issues that are assigned to - you. - - -- Function: forge-insert-authored-issues - This function inserts a list of open issues that are authored by - you. - - The following commands list repositories, notifications and topics in -dedicated buffers: - -‘N l r’ (‘forge-list-repositories’) - This command lists all known repositories in a separate buffer. - -‘N l n’ (‘forge-list-notifications’) - This command lists all notifications for all forges in a separate - buffer. - -‘N l p’ (‘forge-list-pullreqs’) - This command lists the current repository’s pull-requests in a - separate buffer. - -‘N l i’ (‘forge-list-issues’) - This command lists the current repository’s issues in a separate - buffer. - - -- Command: forge-list-labeled-pullreqs - This command lists the current repository’s open pull-requests that - are labeled with a label read from the user. - - -- Command: forge-list-labeled-issues - This command lists the current repository’s open issues that are - labeled with a label read from the user. - - -- Command: forge-list-assigned-pullreqs - This command lists the current repository’s open pull-requests that - are assigned to you in a separate buffer. - - -- Command: forge-list-assigned-issues - This command lists the current repository’s open issues that are - assigned to you in a separate buffer. - - -- Command: forge-list-requested-reviews - This command lists pull-requests of the current repository that are - awaiting your review in a separate buffer. - - -- Command: forge-list-authored-pullreqs - This command lists the current repository’s open pull-requests that - are authored by you in a separate buffer. - - -- Command: forge-list-authored-issues - This command lists the current repository’s open issues that are - authored by you in a separate buffer. - - -- Command: forge-list-owned-pullreqs - This command lists open pull-requests from all the repositories - that you own. Options ‘forge-owned-accounts’ and - ‘forge-owned-ignored’ controls which repositories are considered to - be owned by you. Only Github is supported for now. - - -- Command: forge-list-owned-issues - This command lists open issues from all the repositories that you - own. Options ‘forge-owned-accounts’ and ‘forge-owned-ignored’ - controls which repositories are considered to be owned by you. - Only Github is supported for now. - - -- User Option: forge-owned-accounts - This is an alist of accounts that are owned by you. This should - include your username as well as any organization that you own. - Used by the commands ‘forge-list-owned-issues’, - ‘forge-list-owned-pullreqs’ and ‘forge-fork’. - - Each element has the form ‘(ACCOUNT . PLIST)’. The following - properties are currently being used: - - • ‘remote-name’ The default name suggested by ‘forge-fork’ for a - fork created within this account. If unspecified, then the - name of the account is used. - - Example: ‘(("tarsius") ("emacsmirror" remote-name "mirror"))’. - - -- User Option: forge-owned-ignored - This is a list of repository names that are considered to not be - owned by you even though they would have been considered to be - owned by you based on ‘forge-owned-accounts’. - - -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 N: Branching. (line 13) -* b n: Branching. (line 102) -* C-c C-c: Editing Topics and Posts. - (line 92) -* C-c C-e: Editing Topics and Posts. - (line 100) -* C-c C-e d: Editing Topics and Posts. - (line 105) -* C-c C-e [on "Assignees" section]: Editing Topics and Posts. - (line 56) -* C-c C-e [on "Draft" section]: Editing Topics and Posts. - (line 40) -* C-c C-e [on "Labels" section]: Editing Topics and Posts. - (line 43) -* C-c C-e [on "Marks" section]: Editing Topics and Posts. - (line 47) -* C-c C-e [on "Note" section]: Editing Topics and Posts. - (line 65) -* C-c C-e [on "Review-Requests" section]: Editing Topics and Posts. - (line 60) -* C-c C-e [on "State" section]: Editing Topics and Posts. - (line 36) -* C-c C-e [on "Title" section]: Editing Topics and Posts. - (line 32) -* C-c C-e [on a post section]: Editing Topics and Posts. - (line 27) -* C-c C-k: Editing Topics and Posts. - (line 96) -* C-c C-k [on a comment section]: Editing Topics and Posts. - (line 68) -* C-c C-n: Editing Topics and Posts. - (line 17) -* C-c C-n [on "Issues" section]: Creating Topics. (line 12) -* C-c C-n [on "Pull requests" section]: Creating Topics. (line 8) -* C-c C-r: Editing Topics and Posts. - (line 17) -* C-c C-v: Visiting Topics. (line 36) -* C-c C-w: Visiting Topics. (line 22) -* C-c C-w <1>: Visiting Topics. (line 22) -* f n: Pulling. (line 13) -* f N: Pulling. (line 25) -* m M [if enabled]: Editing Topics and Posts. - (line 72) -* N: Usage. (line 23) -* N a: Usage. (line 13) -* N a <1>: Miscellaneous. (line 15) -* N b I: Visiting Topics. (line 22) -* N b i: Visiting Topics. (line 22) -* N b P: Visiting Topics. (line 22) -* N b p: Visiting Topics. (line 22) -* N b r: Visiting Topics. (line 22) -* N b t: Visiting Topics. (line 22) -* N c f: Miscellaneous. (line 7) -* N c i: Creating Topics. (line 12) -* N c p: Creating Topics. (line 8) -* N f f: Pulling. (line 13) -* N f n: Pulling. (line 25) -* N f t: Pulling. (line 47) -* N l i: Listing Topics and Notifications. - (line 73) -* N l n: Listing Topics and Notifications. - (line 65) -* N l p: Listing Topics and Notifications. - (line 69) -* N l r: Listing Topics and Notifications. - (line 62) -* N M [if enabled]: Editing Topics and Posts. - (line 72) -* N r: Repository Detection. - (line 80) -* N t c: Miscellaneous. (line 28) -* N t t: Miscellaneous. (line 24) -* N v i: Visiting Topics. (line 36) -* N v p: Visiting Topics. (line 36) -* N v t: Visiting Topics. (line 36) -* RET: Visiting Topics. (line 36) -* Z n: Branching. (line 107) - - -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 50) -* forge-insert-assigned-pullreqs: Listing Topics and Notifications. - (line 38) -* forge-insert-authored-issues: Listing Topics and Notifications. - (line 54) -* forge-insert-authored-pullreqs: Listing Topics and Notifications. - (line 46) -* forge-insert-issues: Listing Topics and Notifications. - (line 17) -* forge-insert-pullreqs: Listing Topics and Notifications. - (line 13) -* forge-insert-requested-reviews: Listing Topics and Notifications. - (line 42) -* forge-list-assigned-issues: Listing Topics and Notifications. - (line 88) -* forge-list-assigned-pullreqs: Listing Topics and Notifications. - (line 84) -* forge-list-authored-issues: Listing Topics and Notifications. - (line 100) -* forge-list-authored-pullreqs: Listing Topics and Notifications. - (line 96) -* forge-list-issues: Listing Topics and Notifications. - (line 73) -* forge-list-labeled-issues: Listing Topics and Notifications. - (line 80) -* forge-list-labeled-pullreqs: Listing Topics and Notifications. - (line 76) -* forge-list-notifications: Listing Topics and Notifications. - (line 65) -* forge-list-owned-issues: Listing Topics and Notifications. - (line 110) -* forge-list-owned-pullreqs: Listing Topics and Notifications. - (line 104) -* forge-list-pullreqs: Listing Topics and Notifications. - (line 69) -* forge-list-repositories: Listing Topics and Notifications. - (line 62) -* forge-list-requested-reviews: Listing Topics and Notifications. - (line 92) -* forge-merge: Editing Topics and Posts. - (line 72) -* forge-post-cancel: Editing Topics and Posts. - (line 96) -* forge-post-dispatch: Editing Topics and Posts. - (line 100) -* forge-post-submit: Editing Topics and Posts. - (line 92) -* forge-post-toggle-draft: Editing Topics and Posts. - (line 105) -* forge-pull: Pulling. (line 13) -* forge-pull-notifications: Pulling. (line 25) -* forge-pull-topic: Pulling. (line 47) -* forge-remove-repository: Miscellaneous. (line 44) -* forge-remove-topic-locally: Miscellaneous. (line 48) -* forge-reset-database: Miscellaneous. (line 58) -* forge-toggle-closed-visibility: Listing Topics and Notifications. - (line 31) -* forge-toggle-closed-visibility <1>: Miscellaneous. (line 28) -* forge-toggle-display-in-status-buffer: Miscellaneous. (line 24) -* forge-visit-issue: Visiting Topics. (line 36) -* forge-visit-pullreq: Visiting Topics. (line 36) -* forge-visit-topic: Visiting Topics. (line 36) -* forge-visit-TYPE: Visiting Topics. (line 36) - - -File: forge.info, Node: Variable Index, Prev: Function and Command Index, Up: Top - -Appendix D Variable Index -************************* - -[index] -* Menu: - -* forge-owned-accounts: Listing Topics and Notifications. - (line 116) -* forge-owned-ignored: Listing Topics and Notifications. - (line 131) -* forge-topic-list-limit: Listing Topics and Notifications. - (line 20) -* forge.remote: Repository Detection. - (line 66) - - - -Tag Table: -Node: Top751 -Node: Introduction2435 -Node: Supported Forges and Hosts2998 -Node: Supported Forges4248 -Ref: Github4404 -Ref: Github Caveats4547 -Ref: Github Hosts5193 -Ref: Gitlab5249 -Ref: Gitlab Caveats5264 -Ref: Gitlab Hosts5389 -Node: Partially Supported Forges5509 -Ref: Gitea https//giteaio5715 -Ref: Gitea Hosts5815 -Ref: Gogs https//gogsio5871 -Ref: Gogs Hosts6074 -Ref: Bitbucket https//bitbucketorg6132 -Ref: Bitbucket Caveats6330 -Ref: Bitbucket Hosts7227 -Node: Supported Semi-Forges7292 -Ref: Gitweb https//git-scmcom/docs/gitweb7463 -Ref: Gitweb Caveats7542 -Ref: Cgit https//gitzx2c4com/cgit/about7782 -Ref: Cgit Caveats7859 -Ref: Cgit Hosts8208 -Ref: Stgit https//codemadnessorg/git/stagit/file/READMEhtml8335 -Ref: Stgit Caveats8452 -Ref: Stgit Hosts8738 -Ref: Srht https//metasrht8798 -Ref: Srht Caveats8847 -Ref: Srht Hosts9130 -Node: Getting Started9181 -Node: Loading Forge10179 -Node: Token Creation10574 -Node: Initial Pull11853 -Node: Repository Detection13248 -Node: Caveats17387 -Node: Usage18313 -Node: Pulling19785 -Node: Branching22468 -Node: Working with Topics28857 -Node: Visiting Topics29230 -Node: Listing Topics and Notifications31307 -Node: Creating Topics36631 -Node: Editing Topics and Posts37120 -Node: Miscellaneous41647 -Node: FAQ44270 -Node: Is it possible to create a single pull-request without pulling everything?44738 -Node: error in process filter HTTP Error 502 "Bad gateway"45204 -Node: Keystroke Index47575 -Node: Function and Command Index53265 -Node: Variable Index61223 - -End Tag Table - - -Local Variables: -coding: utf-8 -End: diff --git a/elpa/forge-20230711.1157/dir b/elpa/forge-20230711.1157/dir new file mode 100644 index 00000000..e9289b26 --- /dev/null +++ b/elpa/forge-20230711.1157/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-20230711.1157/forge-autoloads.el b/elpa/forge-20230711.1157/forge-autoloads.el new file mode 100644 index 00000000..fb9bc561 --- /dev/null +++ b/elpa/forge-20230711.1157/forge-autoloads.el @@ -0,0 +1,443 @@ +;;; forge-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "forge" "forge.el" (0 0 0 0)) +;;; Generated autoloads from forge.el + +(defvar forge-add-default-bindings t "\ +Whether to add Forge's bindings to various Magit keymaps. + +If you want to disable this, then you must set this to nil before +`magit' is loaded. If you do it before `forge' but after `magit' +is loaded, then `magit-mode-map' ends up being modified anyway. + +If this is nil, then `forge-toggle-display-in-status-buffer' can +no longer do its job. It might be better to set the global value +of `forge-display-in-status-buffer' to nil instead. That way you +can still display topics on demand in the status buffer.") + +(with-eval-after-load 'git-commit (when forge-add-default-bindings (define-key git-commit-mode-map (kbd "C-c C-v") #'forge-visit-topic))) + +(with-eval-after-load 'magit-mode (when forge-add-default-bindings (define-key magit-mode-map "'" #'forge-dispatch) (define-key magit-mode-map "N" #'forge-dispatch))) + +(register-definition-prefixes "forge" '("forge-")) + +;;;*** + +;;;### (autoloads nil "forge-bitbucket" "forge-bitbucket.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from forge-bitbucket.el + +(register-definition-prefixes "forge-bitbucket" '("forge-bitbucket-repository")) + +;;;*** + +;;;### (autoloads nil "forge-commands" "forge-commands.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from forge-commands.el + (autoload 'forge-dispatch "forge-commands" nil t) + +(autoload 'forge-pull "forge-commands" "\ +Pull topics from the forge repository. + +With a prefix argument and if the repository has not been fetched +before, then read a date from the user and limit pulled topics to +those that have been updated since then. + +If pulling is too slow, then also consider setting the Git variable +`forge.omitExpensive' to `true'. + +\(fn &optional REPO UNTIL)" t nil) + +(autoload 'forge-pull-notifications "forge-commands" "\ +Fetch notifications for all repositories from the current forge." t nil) + +(autoload 'forge-pull-topic "forge-commands" "\ +Pull the API data for the current topic. +If there is no current topic or with a prefix argument read a +TOPIC to pull instead. + +\(fn TOPIC)" t nil) + +(autoload 'forge-browse-dwim "forge-commands" "\ +Visit a topic, branch or commit using a browser. +Prefer a topic over a branch and that over a commit." t nil) + +(autoload 'forge-browse-commit "forge-commands" "\ +Visit the url corresponding to REV using a browser. + +\(fn REV)" t nil) + +(autoload 'forge-copy-url-at-point-as-kill "forge-commands" "\ +Copy the url of the thing at point." t nil) + +(autoload 'forge-browse-branch "forge-commands" "\ +Visit the url corresponding BRANCH using a browser. + +\(fn BRANCH)" t nil) + +(autoload 'forge-browse-remote "forge-commands" "\ +Visit the url corresponding to REMOTE using a browser. + +\(fn REMOTE)" t nil) + +(autoload 'forge-browse-repository "forge-commands" "\ +View the current repository in a separate buffer. + +\(fn REPO)" t nil) + +(autoload 'forge-browse-topic "forge-commands" "\ +Visit the current topic using a browser." t nil) + +(autoload 'forge-browse-pullreqs "forge-commands" "\ +Visit the pull-requests of the current repository using a browser." t nil) + +(autoload 'forge-browse-pullreq "forge-commands" "\ +Visit the url corresponding to PULLREQ using a browser. + +\(fn PULLREQ)" t nil) + +(autoload 'forge-browse-issues "forge-commands" "\ +Visit the issues of the current repository using a browser." t nil) + +(autoload 'forge-browse-issue "forge-commands" "\ +Visit the current issue using a browser. +If there is no current issue or with a prefix argument +read an ISSUE to visit. + +\(fn ISSUE)" t nil) + +(autoload 'forge-browse-post "forge-commands" "\ +Visit the current post using a browser." t nil) + +(autoload 'forge-visit-topic "forge-commands" "\ +View the current topic in a separate buffer. +If there is no current topic or with a prefix argument +read a topic to visit instead. + +\(fn TOPIC)" t nil) + +(autoload 'forge-visit-pullreq "forge-commands" "\ +View the current pull-request in a separate buffer. +If there is no current pull-request or with a prefix argument +read a PULLREQ to visit instead. If point is looking at a pullreq +reference with Gitlab/Github notation try to visit the pullreq +with that number. + +\(fn PULLREQ)" t nil) + +(autoload 'forge-visit-issue "forge-commands" "\ +Visit the current issue in a separate buffer. +If there is no current issue or with a prefix argument read an +ISSUE to visit instead. If point is looking at an issue reference +with Gitlab/Github notation try to visit the issue with that +number. + +\(fn ISSUE)" t nil) + +(autoload 'forge-visit-repository "forge-commands" "\ +View the current repository in a separate buffer. + +\(fn REPO)" t nil) + +(autoload 'forge-branch-pullreq "forge-commands" "\ +Create and configure a new branch from a pull-request. +Please see the manual for more information. + +\(fn PULLREQ)" t nil) + +(autoload 'forge-checkout-pullreq "forge-commands" "\ +Create, configure and checkout a new branch from a pull-request. +Please see the manual for more information. + +\(fn PULLREQ)" t nil) + +(autoload 'forge-checkout-worktree "forge-commands" "\ +Create, configure and checkout a new worktree from a pull-request. +This is like `forge-checkout-pullreq', except that it also +creates a new worktree. Please see the manual for more +information. + +\(fn PATH PULLREQ)" t nil) + +(autoload 'forge-fork "forge-commands" "\ +Fork the current repository to FORK and add it as a REMOTE. +If the fork already exists, then that isn't an error; the remote +is added anyway. Currently this only supports Github and Gitlab. + +\(fn FORK REMOTE)" t nil) + +(autoload 'forge-list-notifications "forge-commands" "\ +List notifications." t nil) + +(autoload 'forge-add-pullreq-refspec "forge-commands" "\ +Configure Git to fetch all pull-requests. +This is done by adding \"+refs/pull/*/head:refs/pullreqs/*\" +to the value of `remote.REMOTE.fetch', where REMOTE is the +upstream remote. Also fetch from REMOTE." t nil) + +(autoload 'forge-add-repository "forge-commands" "\ +Add a repository to the database. +Offer to either pull topics (now and in the future) or to only +pull individual topics when the user invokes `forge-pull-topic'. + +\(fn URL)" t nil) + +(function-put 'forge-add-repository 'interactive-only 't) + +(autoload 'forge-add-user-repositories "forge-commands" "\ +Add all of USER's repositories from HOST to the database. +This may take a while. Only Github is supported at the moment. + +\(fn HOST USER)" t nil) + +(autoload 'forge-add-organization-repositories "forge-commands" "\ +Add all of ORGANIZATION's repositories from HOST to the database. +This may take a while. Only Github is supported at the moment. + +\(fn HOST ORGANIZATION)" t nil) + +(autoload 'forge-merge "forge-commands" "\ +Merge the current pull-request using METHOD using the forge's API. + +If there is no current pull-request or with a prefix argument, +then read pull-request PULLREQ to visit instead. + +Use of this command is discouraged. Unless the remote repository +is configured to disallow that, you should instead merge locally +and then push the target branch. Forges detect that you have +done that and respond by automatically marking the pull-request +as merged. + +\(fn PULLREQ METHOD)" t nil) + +(autoload 'forge-remove-repository "forge-commands" "\ +Remove a repository from the database. + +\(fn HOST OWNER NAME)" t nil) + +(autoload 'forge-remove-topic-locally "forge-commands" "\ +Remove a topic from the local database only. +Due to how the supported APIs work, it would be too expensive to +automatically remove topics from the local database that were +removed from the forge. The purpose of this command is to allow +you to manually clean up the local database. + +\(fn TOPIC)" t nil) + +(autoload 'forge-rename-default-branch "forge-commands" "\ +Rename the default branch to NEWNAME. +Change the name on the upstream remote and locally, and update +the upstream remotes of local branches accordingly." t nil) + +(autoload 'forge-reset-database "forge-commands" "\ +Move the current database file to the trash. +This is useful after the database scheme has changed, which will +happen a few times while the forge functionality is still under +heavy development." t nil) + +(register-definition-prefixes "forge-commands" '("forge-")) + +;;;*** + +;;;### (autoloads nil "forge-core" "forge-core.el" (0 0 0 0)) +;;; Generated autoloads from forge-core.el + +(register-definition-prefixes "forge-core" '("forge-")) + +;;;*** + +;;;### (autoloads nil "forge-db" "forge-db.el" (0 0 0 0)) +;;; Generated autoloads from forge-db.el + +(register-definition-prefixes "forge-db" '("forge-")) + +;;;*** + +;;;### (autoloads nil "forge-gitea" "forge-gitea.el" (0 0 0 0)) +;;; Generated autoloads from forge-gitea.el + +(register-definition-prefixes "forge-gitea" '("forge-gitea-repository")) + +;;;*** + +;;;### (autoloads nil "forge-github" "forge-github.el" (0 0 0 0)) +;;; Generated autoloads from forge-github.el + +(register-definition-prefixes "forge-github" '("forge-")) + +;;;*** + +;;;### (autoloads nil "forge-gitlab" "forge-gitlab.el" (0 0 0 0)) +;;; Generated autoloads from forge-gitlab.el + +(register-definition-prefixes "forge-gitlab" '("forge-gitlab-repository")) + +;;;*** + +;;;### (autoloads nil "forge-gogs" "forge-gogs.el" (0 0 0 0)) +;;; Generated autoloads from forge-gogs.el + +(register-definition-prefixes "forge-gogs" '("forge-gogs-repository")) + +;;;*** + +;;;### (autoloads nil "forge-issue" "forge-issue.el" (0 0 0 0)) +;;; Generated autoloads from forge-issue.el + +(register-definition-prefixes "forge-issue" '("forge-")) + +;;;*** + +;;;### (autoloads nil "forge-list" "forge-list.el" (0 0 0 0)) +;;; Generated autoloads from forge-list.el + +(autoload 'forge-list-topics "forge-list" "\ +List topics of the current repository in a separate buffer. + +\(fn ID)" t nil) + +(autoload 'forge-list-issues "forge-list" "\ +List issues of the current repository in a separate buffer. + +\(fn ID)" t nil) + +(autoload 'forge-list-labeled-issues "forge-list" "\ +List issues of the current repository that have LABEL. +List them in a separate buffer. + +\(fn ID LABEL)" t nil) + +(autoload 'forge-list-assigned-issues "forge-list" "\ +List issues of the current repository that are assigned to you. +List them in a separate buffer. + +\(fn ID)" t nil) + +(autoload 'forge-list-owned-issues "forge-list" "\ +List open issues from all your Github repositories. +Options `forge-owned-accounts' and `forge-owned-ignored' +controls which repositories are considered to be owned by you. +Only Github is supported for now." t nil) + +(autoload 'forge-list-pullreqs "forge-list" "\ +List pull-requests of the current repository in a separate buffer. + +\(fn ID)" t nil) + +(autoload 'forge-list-labeled-pullreqs "forge-list" "\ +List pull-requests of the current repository that have LABEL. +List them in a separate buffer. + +\(fn ID LABEL)" t nil) + +(autoload 'forge-list-assigned-pullreqs "forge-list" "\ +List pull-requests of the current repository that are assigned to you. +List them in a separate buffer. + +\(fn ID)" t nil) + +(autoload 'forge-list-requested-reviews "forge-list" "\ +List pull-requests of the current repository that are awaiting your review. +List them in a separate buffer. + +\(fn ID)" t nil) + +(autoload 'forge-list-owned-pullreqs "forge-list" "\ +List open pull-requests from all your Github repositories. +Options `forge-owned-accounts' and `forge-owned-ignored' +controls which repositories are considered to be owned by you. +Only Github is supported for now." t nil) + +(autoload 'forge-list-authored-pullreqs "forge-list" "\ +List open pull-requests of the current repository that are authored by you. +List them in a separate buffer. + +\(fn ID)" t nil) + +(autoload 'forge-list-authored-issues "forge-list" "\ +List open issues from the current repository that are authored by you. +List them in a separate buffer. + +\(fn ID)" t nil) + +(autoload 'forge-list-repositories "forge-list" "\ +List known repositories in a separate buffer. +Here \"known\" means that an entry exists in the local database." t nil) + +(autoload 'forge-list-owned-repositories "forge-list" "\ +List your own known repositories in a separate buffer. +Here \"known\" means that an entry exists in the local database +and options `forge-owned-accounts' and `forge-owned-ignored' +controls which repositories are considered to be owned by you. +Only Github is supported for now." t nil) + +(register-definition-prefixes "forge-list" '("forge-")) + +;;;*** + +;;;### (autoloads nil "forge-notify" "forge-notify.el" (0 0 0 0)) +;;; Generated autoloads from forge-notify.el + +(register-definition-prefixes "forge-notify" '("forge-")) + +;;;*** + +;;;### (autoloads nil "forge-post" "forge-post.el" (0 0 0 0)) +;;; Generated autoloads from forge-post.el + +(register-definition-prefixes "forge-post" '("forge-")) + +;;;*** + +;;;### (autoloads nil "forge-pullreq" "forge-pullreq.el" (0 0 0 0)) +;;; Generated autoloads from forge-pullreq.el + +(register-definition-prefixes "forge-pullreq" '("forge-")) + +;;;*** + +;;;### (autoloads nil "forge-repo" "forge-repo.el" (0 0 0 0)) +;;; Generated autoloads from forge-repo.el + +(register-definition-prefixes "forge-repo" '("forge-")) + +;;;*** + +;;;### (autoloads nil "forge-revnote" "forge-revnote.el" (0 0 0 0)) +;;; Generated autoloads from forge-revnote.el + +(register-definition-prefixes "forge-revnote" '("forge-revnote")) + +;;;*** + +;;;### (autoloads nil "forge-semi" "forge-semi.el" (0 0 0 0)) +;;; Generated autoloads from forge-semi.el + +(register-definition-prefixes "forge-semi" '("forge-")) + +;;;*** + +;;;### (autoloads nil "forge-topic" "forge-topic.el" (0 0 0 0)) +;;; Generated autoloads from forge-topic.el + +(register-definition-prefixes "forge-topic" '("forge-")) + +;;;*** + +;;;### (autoloads nil nil ("forge-pkg.el") (0 0 0 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; forge-autoloads.el ends here diff --git a/elpa/forge-20230711.1157/forge-bitbucket.el b/elpa/forge-20230711.1157/forge-bitbucket.el new file mode 100644 index 00000000..c677e036 --- /dev/null +++ b/elpa/forge-20230711.1157/forge-bitbucket.el @@ -0,0 +1,46 @@ +;;; forge-bitbucket.el --- Bitbucket support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 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-20230711.1157/forge-commands.el b/elpa/forge-20230711.1157/forge-commands.el new file mode 100644 index 00000000..b3f98a1e --- /dev/null +++ b/elpa/forge-20230711.1157/forge-commands.el @@ -0,0 +1,1149 @@ +;;; forge-commands.el --- Commands -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 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." + [["Fetch" + ("f f" "all topics" forge-pull) + ("f t" "one topic" forge-pull-topic) + ("f n" "notifications" forge-pull-notifications) + """Create" + ("c i" "issue" forge-create-issue) + ("c p" "pull-request" forge-create-pullreq) + ("c u" "pull-request from issue" forge-create-pullreq-from-issue + :if (lambda () (forge-github-repository-p (forge-get-repository nil)))) + ("c f" "fork or remote" forge-fork) + """Merge" + (7 "M " "merge using API" forge-merge)] + ["List" + ("l t" "topics" forge-list-topics) + ("l i" "issues" forge-list-issues) + ("l p" "pull-requests" forge-list-pullreqs) + ("l n" "notifications" forge-list-notifications) + ("l r" "repositories" forge-list-repositories) + (7 "l a" "awaiting review" forge-list-requested-reviews) + (7 "n i" "labeled issues" forge-list-labeled-issues) + (7 "n p" "labeled pull-requests" forge-list-labeled-pullreqs) + (7 "m i" "authored issues" forge-list-authored-issues) + (7 "m p" "authored pull-requests" forge-list-authored-pullreqs) + (7 "o i" "owned issues" forge-list-owned-issues) + (7 "o p" "owned pull-requests" forge-list-owned-pullreqs) + (7 "o r" "owned repositories" forge-list-owned-repositories)] + ["Visit" + ("v t" "topic" forge-visit-topic) + ("v i" "issue" forge-visit-issue) + ("v p" "pull-request" forge-visit-pullreq) + """Browse" + ("b I" "issues" forge-browse-issues) + ("b P" "pull-requests" forge-browse-pullreqs) + ("b t" "topic" forge-browse-topic) + ("b i" "issue" forge-browse-issue) + ("b p" "pull-request" forge-browse-pullreq) + ("b r" "remote" forge-browse-remote)]] + [["Configure" + ("a " "add repository to database" forge-add-repository) + ("R " "add pull-request refspec" forge-add-pullreq-refspec + :if-not forge--pullreq-refspec) + ("r " "forge.remote" forge-forge.remote) + ("t l" "forge.graphqlItemLimit" forge-forge.graphqlItemLimit + :if (lambda () (forge-github-repository-p (forge-get-repository nil)))) + ("t t" forge-toggle-display-in-status-buffer) + ("t c" forge-toggle-closed-visibility)]]) + +;;; Pull + +;;;###autoload +(defun forge-pull (&optional repo until interactive) + "Pull topics from the forge repository. + +With a prefix argument and if the repository has not been fetched +before, then read a date from the user and limit pulled topics to +those that have been updated since then. + +If pulling is too slow, then also consider setting the Git variable +`forge.omitExpensive' to `true'. +\n(fn &optional REPO UNTIL)" + (interactive + (list nil + (and current-prefix-arg + (not (forge-get-repository 'full)) + (forge-read-date "Limit pulling to topics updates since: ")) + t)) + (let (create) + (unless repo + (setq repo (forge-get-repository 'full)) + (unless repo + (setq repo (forge-get-repository 'create)) + (setq create t))) + (when (or create interactive (magit-git-config-p "forge.autoPull" t)) + (forge--zap-repository-cache repo) + (when (and interactive + (oref repo selective-p) + (yes-or-no-p + (format "Always pull all of %s/%s's topics going forward?" + (oref repo owner) + (oref repo name)))) + (oset repo selective-p nil)) + (setq forge--mode-line-buffer (current-buffer)) + (when-let* ((remote (oref repo remote)) + (refspec (oref repo pullreq-refspec))) + (when (and create + (not (member refspec (magit-get-all "remote" remote "fetch"))) + (or (eq forge-add-pullreq-refspec t) + (and (eq forge-add-pullreq-refspec 'ask) + (y-or-n-p (format "Also add %S refspec? " refspec))))) + (magit-call-git "config" "--add" + (format "remote.%s.fetch" remote) + refspec))) + (forge--msg repo t nil "Pulling REPO") + (forge--pull repo until)))) + +(defun forge-read-date (prompt) + (cl-block nil + (while t + (let ((str (read-from-minibuffer prompt))) + (cond ((string-equal str "") + (cl-return nil)) + ((string-match-p + "\\`[0-9]\\{4\\}[-/][0-9]\\{2\\}[-/][0-9]\\{2\\}\\'" str) + (cl-return str)))) + (message "Please enter a date in the format YYYY-MM-DD.") + (sit-for 1)))) + +(cl-defmethod forge--pull ((repo forge-noapi-repository) _until) ; NOOP + (forge--msg repo t t "Pulling from REPO is not supported")) + +(cl-defmethod forge--pull ((repo forge-unusedapi-repository) _until) + (oset repo sparse-p nil) + (magit-git-fetch (oref repo remote) (magit-fetch-arguments))) + +(defun forge--git-fetch (buf dir repo) + (if (buffer-live-p buf) + (with-current-buffer buf + (magit-git-fetch (oref repo remote) (magit-fetch-arguments))) + (let ((default-directory dir)) + (magit-git-fetch (oref repo remote) (magit-fetch-arguments))))) + +;;;###autoload +(defun forge-pull-notifications () + "Fetch notifications for all repositories from the current forge." + (interactive) + (let* ((repo (forge-get-repository 'stub)) + (class (eieio-object-class repo))) + (if (eq class 'forge-github-repository) + (forge--pull-notifications class (oref repo githost)) + (user-error "Fetching notifications not supported for forge %S" + (oref repo forge))))) + +;;;###autoload +(defun forge-pull-topic (topic) + "Pull the API data for the current topic. +If there is no current topic or with a prefix argument read a +TOPIC to pull instead." + (interactive (list (forge-read-topic "Pull topic" nil t))) + (let ((repo (forge-get-repository t))) + (forge--zap-repository-cache repo) + (forge--pull-topic repo + (if (numberp topic) + (forge-issue :repository (oref repo id) + :number topic) + (forge-get-topic topic))))) + +(cl-defmethod forge--pull-topic ((repo forge-repository) _topic) + (error "Fetching an individual topic not implemented for %s" + (eieio-object-class repo))) + +(defun forge--zap-repository-cache (&optional repo) + (when-let ((r (if repo + (oref repo worktree) + (magit-repository-local-repository)))) + (magit-repository-local-delete (list 'forge-ls-recent-topics 'issue) r) + (magit-repository-local-delete (list 'forge-ls-recent-topics 'pullreq) r))) + +;;; Browse + +;;;###autoload +(defun forge-browse-dwim () + "Visit a topic, branch or commit using a browser. +Prefer a topic over a branch and that over a commit." + (interactive) + (if-let ((topic (forge-topic-at-point))) + (forge-browse topic) + (if-let ((branch (magit-branch-at-point))) + (forge-browse-branch branch) + (call-interactively #'forge-browse-commit)))) + +;;;###autoload +(defun forge-browse-commit (rev) + "Visit the url corresponding to REV using a browser." + (interactive + (list (or (magit-completing-read "Browse commit" + (magit-list-branch-names) + nil nil nil 'magit-revision-history + (magit-branch-or-commit-at-point)) + (user-error "Nothing selected")))) + (let ((repo (forge-get-repository 'stub))) + (unless (magit-list-containing-branches + rev "-r" (concat (oref repo remote) "/*")) + (if-let ((branch (car (magit-list-containing-branches rev "-r")))) + (setq repo (forge-get-repository + 'stub (cdr (magit-split-branch-name branch)))) + (message "%s does not appear to be available on any remote. %s" + rev "You might have to push it first."))) + (browse-url + (forge--format repo 'commit-url-format + `((?r . ,(magit-commit-p rev))))))) + +;;;###autoload +(defun forge-copy-url-at-point-as-kill () + "Copy the url of the thing at point." + (interactive) + (if-let ((url (forge-get-url (or (forge-post-at-point) + (forge-current-topic))))) + (progn + (kill-new url) + (message "Copied %S" url)) + (user-error "Nothing at point with a URL"))) + +;;;###autoload +(defun forge-browse-branch (branch) + "Visit the url corresponding BRANCH using a browser." + (interactive (list (magit-read-branch "Browse branch"))) + (let (remote) + (if (magit-remote-branch-p branch) + (let ((cons (magit-split-branch-name branch))) + (setq remote (car cons)) + (setq branch (cdr cons))) + (or (setq remote (or (magit-get-push-remote branch) + (magit-get-upstream-remote branch))) + (user-error "Cannot determine remote for %s" branch))) + (browse-url (forge--format remote 'branch-url-format + `((?r . ,branch)))))) + +;;;###autoload +(defun forge-browse-remote (remote) + "Visit the url corresponding to REMOTE using a browser." + (interactive (list (magit-read-remote "Browse remote"))) + (browse-url (forge--format remote 'remote-url-format))) + +;;;###autoload +(defun forge-browse-repository (repo) + "View the current repository in a separate buffer." + (interactive + (list (or (forge-current-repository) + (forge-get-repository + (forge-read-repository "Browse repository"))))) + (browse-url (forge--format repo 'remote-url-format))) + +;;;###autoload +(defun forge-browse-topic () + "Visit the current topic using a browser." + (interactive) + (if-let ((topic (forge-current-topic))) + (forge-browse topic) + (user-error "There is no current topic"))) + +;;;###autoload +(defun forge-browse-pullreqs () + "Visit the pull-requests of the current repository using a browser." + (interactive) + (browse-url (forge--format (forge-get-repository 'stub) + 'pullreqs-url-format))) + +;;;###autoload +(defun forge-browse-pullreq (pullreq) + "Visit the url corresponding to PULLREQ using a browser." + (interactive (list (forge-read-pullreq "Browse pull-request" t))) + (forge-browse (forge-get-pullreq pullreq))) + +;;;###autoload +(defun forge-browse-issues () + "Visit the issues of the current repository using a browser." + (interactive) + (browse-url (forge--format (forge-get-repository 'stub) + 'issues-url-format))) + +;;;###autoload +(defun forge-browse-issue (issue) + "Visit the current issue using a browser. +If there is no current issue or with a prefix argument +read an ISSUE to visit." + (interactive (list (forge-read-issue "Browse issue" t))) + (forge-browse (forge-get-issue issue))) + +;;;###autoload +(defun forge-browse-post () + "Visit the current post using a browser." + (interactive) + (if-let ((post (forge-post-at-point))) + (forge-browse post) + (user-error "There is no current post"))) + +;;; Visit + +;;;###autoload +(defun forge-visit-topic (topic) + "View the current topic in a separate buffer. +If there is no current topic or with a prefix argument +read a topic to visit instead." + (interactive (list (if-let ((topic (forge-current-topic))) + (oref topic id) + (forge-read-topic "View topic")))) + (forge-visit (forge-get-topic topic))) + +;;;###autoload +(defun forge-visit-pullreq (pullreq) + "View the current pull-request in a separate buffer. +If there is no current pull-request or with a prefix argument +read a PULLREQ to visit instead. If point is looking at a pullreq +reference with Gitlab/Github notation try to visit the pullreq +with that number." + (interactive (list (forge-read-pullreq "View pull-request" t))) + (forge-visit (forge-get-pullreq pullreq))) + +;;;###autoload +(defun forge-visit-issue (issue) + "Visit the current issue in a separate buffer. +If there is no current issue or with a prefix argument read an +ISSUE to visit instead. If point is looking at an issue reference +with Gitlab/Github notation try to visit the issue with that +number." + (interactive (list (forge-read-issue "View issue" t))) + (forge-visit (forge-get-issue issue))) + +;;;###autoload +(defun forge-visit-repository (repo) + "View the current repository in a separate buffer." + (interactive + (list (or (forge-current-repository) + (forge-get-repository + (forge-read-repository "Visit repository"))))) + (forge-visit repo)) + +;;; Create + +(defun forge-create-pullreq (source target) + "Create a new pull-request for the current repository." + (interactive (forge-create-pullreq--read-args)) + (let* ((repo (forge-get-repository t)) + (buf (forge--prepare-post-buffer + "new-pullreq" + (forge--format repo "Create new pull-request on %p") + source target))) + (with-current-buffer buf + (setq forge--buffer-base-branch target) + (setq forge--buffer-head-branch source) + (setq forge--buffer-post-object repo) + (setq forge--submit-post-function #'forge--submit-create-pullreq) + (run-hooks 'forge-create-pullreq-hook)) + (forge--display-post-buffer buf))) + +(defun forge-create-pullreq-from-issue (issue source target) + "Convert an existing ISSUE into a pull-request." + (interactive (cons (forge-read-issue "Convert issue") + (forge-create-pullreq--read-args))) + (setq issue (forge-get-issue issue)) + (forge--create-pullreq-from-issue (forge-get-repository issue) + issue source target)) + +(defun forge-create-pullreq--read-args () + (let* ((source (magit-completing-read + "Source branch" + (magit-list-remote-branch-names) + nil t nil 'magit-revision-history + (or (and-let* ((d (magit-branch-at-point))) + (if (magit-remote-branch-p d) + d + (magit-get-push-branch d t))) + (and-let* ((d (magit-get-current-branch))) + (if (magit-remote-branch-p d) + d + (magit-get-push-branch d t)))))) + (repo (forge-get-repository t)) + (remote (oref repo remote)) + (targets (delete source (magit-list-remote-branch-names remote))) + (target (magit-completing-read + "Target branch" targets nil t nil 'magit-revision-history + (let* ((d (cdr (magit-split-branch-name source))) + (d (and (magit-branch-p d) d)) + (d (and d (magit-get-upstream-branch d))) + (d (and d (if (magit-remote-branch-p d) + d + (magit-get-upstream-branch d)))) + (d (or d (concat remote "/" + (or (oref repo default-branch) + "master"))))) + (car (member d targets)))))) + (list source target))) + +(defun forge-create-issue () + "Create a new issue for the current repository." + (interactive) + (let* ((repo (forge-get-repository t)) + (buf (forge--prepare-post-buffer + "new-issue" + (forge--format repo "Create new issue on %p")))) + (when buf + (with-current-buffer buf + (setq forge--buffer-post-object repo) + (setq forge--submit-post-function #'forge--submit-create-issue)) + (forge--display-post-buffer buf)))) + +(defun forge-create-post (&optional quote) + "Create a new post on an existing topic. +If the region is active, then quote that part of the post. +Otherwise and with a prefix argument quote the post that +point is currently on." + (interactive (list current-prefix-arg)) + (unless (derived-mode-p 'forge-topic-mode) + (user-error "This command is only available from topic buffers")) + (let* ((topic forge-buffer-topic) + (buf (forge--prepare-post-buffer + (forge--format topic "%i;new-comment") + (forge--format topic "New comment on #%i of %p"))) + (quote (cond + ((not (magit-section-match 'post)) nil) + ((use-region-p) + (buffer-substring-no-properties (region-beginning) + (region-end))) + (quote + (let ((section (magit-current-section))) + (string-trim-right + (buffer-substring-no-properties (oref section content) + (oref section end)))))))) + (with-current-buffer buf + (setq forge--buffer-post-object topic) + (setq forge--submit-post-function #'forge--submit-create-post) + (when quote + (goto-char (point-max)) + (unless (bobp) + (insert "\n")) + (insert (replace-regexp-in-string "^" "> " quote) "\n\n"))) + (forge--display-post-buffer buf))) + +;;; Edit + +(defun forge-edit-post () + "Edit the current post." + (interactive) + (let* ((post (or (forge-post-at-point) + (user-error "There is no current post"))) + (buf (cl-typecase post + (forge-topic + (forge--prepare-post-buffer + (forge--format post "%i") + (forge--format post "Edit #%i of %p"))) + (forge-post + (forge--prepare-post-buffer + (forge--format post "%i;%I") + (forge--format post "Edit comment on #%i of %p")))))) + (with-current-buffer buf + (setq forge--buffer-post-object post) + (setq forge--submit-post-function #'forge--submit-edit-post) + (erase-buffer) + (when (cl-typep post 'forge-topic) + (insert "# " (oref post title) "\n\n")) + (insert (oref post body))) + (forge--display-post-buffer buf))) + +(defun forge-edit-topic-title (topic) + "Edit the title of the current topic. +If there is no current topic or with a prefix argument read a +TOPIC and modify that instead." + (interactive (list (forge-read-topic "Edit title of"))) + (let ((topic (forge-get-topic topic))) + (forge--set-topic-title + (forge-get-repository topic) topic + (read-string "Title: " (oref topic title))))) + +(defun forge-edit-topic-state (topic) + "Close or reopen the current topic. +If there is no current topic or with a prefix argument read a +TOPIC and modify that instead." + (interactive + (let* ((id (forge-read-topic "Close/reopen")) + (topic (forge-get-topic id))) + (if (magit-y-or-n-p + (format "%s %S" + (cl-ecase (oref topic state) + (merged (error "Merged pull-requests cannot be reopened")) + (closed "Reopen") + (open "Close")) + (car (forge--topic-format-choice topic)))) + (list id) + (user-error "Abort")))) + (let ((topic (forge-get-topic topic))) + (forge--set-topic-state (forge-get-repository topic) topic))) + +(defun forge-edit-topic-draft (pullreq) + "Toggle whether the current pull-request is a draft. +If there is no current topic or with a prefix argument read a +TOPIC and modify that instead." + (interactive (list (forge-read-pullreq "Toggle draft state of"))) + (let ((pullreq (forge-get-pullreq pullreq))) + (forge--set-topic-draft (forge-get-repository pullreq) + pullreq + (not (oref pullreq draft-p))))) + +(defun forge-edit-topic-milestone (topic) + (interactive (list (forge-read-topic "Edit milestone of"))) + (let* ((topic (forge-get-topic topic)) + (repo (forge-get-repository topic))) + (forge--set-topic-milestone + repo topic + (magit-completing-read + "Milestone" + (mapcar #'caddr (oref repo milestones)) + nil t (forge--get-topic-milestone topic))))) + +(defun forge-edit-topic-labels (topic) + "Edit the labels of the current topic. +If there is no current topic or with a prefix argument read a +TOPIC and modify that instead." + (interactive (list (forge-read-topic "Edit labels of"))) + (let* ((topic (forge-get-topic topic)) + (repo (forge-get-repository topic)) + (crm-separator ",")) + (forge--set-topic-labels + repo topic (magit-completing-read-multiple + "Labels: " + (mapcar #'cadr (oref repo labels)) + nil t + (mapconcat #'car (closql--iref topic 'labels) ","))))) + +(defun forge-edit-topic-marks (topic marks) + "Edit the marks of the current topic. +If there is no current topic or with a prefix argument read a +TOPIC and modify that instead." + (interactive + (let ((topic (forge-read-topic "Edit marks of"))) + (list topic (forge-read-marks "Marks: " (forge-get-topic topic))))) + (oset (forge-get-topic topic) marks marks) + (magit-refresh)) + +(defun forge-edit-topic-assignees (topic) + "Edit the assignees of the current topic. +If there is no current topic or with a prefix argument read a +TOPIC and modify that instead." + (interactive (list (forge-read-topic "Edit assignees of"))) + (let* ((topic (forge-get-topic topic)) + (repo (forge-get-repository topic)) + (value (closql--iref topic 'assignees)) + (choices (mapcar #'cadr (oref repo assignees))) + (crm-separator ",")) + (forge--set-topic-assignees + repo topic + (magit-completing-read-multiple + "Assignees: " choices nil + (if (forge--childp repo 'forge-gitlab-repository) + t ; Selecting something else would fail later on. + 'confirm) + (mapconcat #'car value ","))))) + +(defun forge-edit-topic-review-requests (pullreq) + "Edit the review-requests of the current pull-request. +If there is no current topic or with a prefix argument read a +PULLREQ and modify that instead." + (interactive (list (forge-read-pullreq "Request review for"))) + (let* ((topic (forge-get-pullreq pullreq)) + (repo (forge-get-repository topic)) + (value (closql--iref topic 'review-requests)) + (choices (mapcar #'cadr (oref repo assignees))) + (crm-separator ",")) + (forge--set-topic-review-requests + repo topic + (magit-completing-read-multiple + "Request review from: " choices nil + 'confirm + (mapconcat #'car value ","))))) + +(defun forge-edit-topic-note (topic) + "Edit your private note about the current topic. +If there is no current topic or with a prefix argument read a +TOPIC and modify that instead." + (interactive (list (forge-read-topic "Edit note about"))) + (let* ((topic (forge-get-topic topic)) + (buf (forge--prepare-post-buffer + (forge--format topic "%i;note") + (forge--format topic "New note on #%i of %p")))) + (with-current-buffer buf + (setq forge--buffer-post-object topic) + (setq forge--submit-post-function #'forge--save-note) + (erase-buffer) + (when-let ((note (oref topic note))) + (save-excursion (insert note ?\n)))) + (forge--display-post-buffer buf))) + +;;; Delete + +(defun forge-delete-comment (comment) + "Delete the comment at point." + (interactive (list (or (forge-comment-at-point) + (user-error "There is no comment at point")))) + (when (yes-or-no-p "Do you really want to delete the selected comment? ") + (forge--delete-comment (forge-get-repository t) comment))) + +;;; Branch + +;;;###autoload +(defun forge-branch-pullreq (pullreq) + "Create and configure a new branch from a pull-request. +Please see the manual for more information." + (interactive (list (forge-read-pullreq "Branch pull request" t))) + (let ((pullreq (forge-get-pullreq pullreq))) + (if-let ((branch (forge--pullreq-branch-active pullreq))) + (progn (message "Branch %S already exists and is configured" branch) + branch) + (forge--branch-pullreq (forge-get-repository pullreq) pullreq) + (magit-refresh)))) + +(cl-defmethod forge--branch-pullreq ((pullreq forge-pullreq)) + (forge--branch-pullreq (forge-get-repository pullreq) pullreq)) + +(cl-defmethod forge--branch-pullreq ((_repo forge-unusedapi-repository) pullreq) + ;; We don't know enough to do a good job. + (let* ((number (oref pullreq number)) + (branch (format "pr-%s" number))) + (when (magit-branch-p branch) + (user-error "Branch `%s' already exists" branch)) + (magit-git "branch" branch (forge--pullreq-ref pullreq)) + ;; More often than not this is the correct target branch. + (magit-call-git "branch" branch "--set-upstream-to=master") + (magit-set (number-to-string number) "branch" branch "pullRequest") + branch)) + +(cl-defmethod forge--branch-pullreq ((repo forge-repository) pullreq) + (let* ((number (oref pullreq number)) + (branch-n (format "pr-%s" number)) + (branch (or (forge--pullreq-branch-internal pullreq) branch-n)) + (pullreq-ref (format "refs/pullreqs/%s" number))) + (cond ((and-let* ((pr-branch (oref pullreq head-ref))) + (string-search ":" pr-branch)) + ;; Such a branch name would be invalid. If we encounter + ;; it anyway, then that means that the source branch and + ;; the merge-request ref are missing. Luckily Gitlab no + ;; longer does this, but we nevertheless have to deal + ;; with merge-requests that have been lost in time. + (error "Cannot check out this merge-request because %s" + "on old Gitlab version discarded the source branch")) + ((not (eq (oref pullreq state) 'open)) + (magit-git "branch" "--force" branch pullreq-ref)) + (t + (let ((upstream (oref repo remote)) + (pr-remote (oref pullreq head-user)) + (pr-branch (oref pullreq head-ref))) + (cond ((not (oref pullreq cross-repo-p)) + (let ((tracking (concat upstream "/" pr-branch))) + (unless (magit-branch-p tracking) + (magit-call-git "fetch" upstream)) + (forge--setup-pullreq-branch branch tracking) + (magit-branch-maybe-adjust-upstream branch tracking) + (magit-set upstream "branch" branch "pushRemote") + (magit-set upstream "branch" branch "pullRequestRemote"))) + ((not pr-branch) + ;; The pullreq branch (on Github) has been deleted. + (setq pr-remote nil) + (setq branch branch-n) + (forge--setup-pullreq-branch branch pullreq-ref) + (magit-set upstream "branch" branch "pushRemote")) + (t + ;; For prs within the upstream we are more permissive, + ;; but any request to merge a branch with a well known + ;; name from fork, is highly suspicious and likely the + ;; result of a contributor not bothering to name their + ;; feature branch. + (when (and (member branch magit-main-branch-names) + (magit-branch-p branch)) + (setq branch branch-n)) + (forge--setup-pullreq-remote pullreq) + (forge--setup-pullreq-branch + branch (concat pr-remote "/" pr-branch)) + (if (and (oref pullreq editable-p) + (equal branch pr-branch)) + (magit-set pr-remote "branch" branch "pushRemote") + (magit-set upstream "branch" branch "pushRemote")))) + (when pr-remote + (magit-set pr-remote "branch" branch "pullRequestRemote")) + (magit-set "true" "branch" branch "rebase") + (magit-git "branch" branch + (let ((base-ref (oref pullreq base-ref))) + (concat "--set-upstream-to=" + (if (or magit-branch-prefer-remote-upstream + (not (magit-branch-p base-ref))) + (concat upstream "/" base-ref) + base-ref))))))) + (magit-set (number-to-string number) "branch" branch "pullRequest") + (magit-set (oref pullreq title) "branch" branch "description") + branch)) + +(defun forge--setup-pullreq-branch (branch tracking) + (if (magit-branch-p branch) + (unless (magit-rev-equal branch tracking) + (message "Existing branch %s diverged from %s" branch tracking)) + (magit-git "branch" branch tracking))) + +(defun forge--setup-pullreq-remote (pullreq) + (let* ((pr-remote (oref pullreq head-user)) + (pr-branch (oref pullreq head-ref)) + (repo (forge-get-repository pullreq)) + (host (oref repo githost)) + (fork (oref pullreq head-repo))) + (if (magit-remote-p pr-remote) + (let ((url (magit-git-string "remote" "get-url" pr-remote)) + (fetch (magit-get-all "remote" pr-remote "fetch"))) + (unless (forge--url-equal url (format "git@%s:%s.git" host fork)) + (user-error "Remote `%s' already exists but does not point to %s" + pr-remote url)) + (unless (or (member (format "+refs/heads/*:refs/remotes/%s/*" + pr-remote) + fetch) + (member (format "+refs/heads/%s:refs/remotes/%s/%s" + pr-branch pr-remote pr-branch) + fetch)) + (magit-git "remote" "set-branches" "--add" pr-remote pr-branch) + (magit-git "fetch" pr-remote))) + (let ((url (magit-git-string "remote" "get-url" (oref repo remote)))) + (magit-git + "remote" "add" "-f" "--no-tags" + "-t" pr-branch pr-remote + (cond ((or (string-prefix-p "git@" url) + (string-prefix-p "ssh://git@" url)) + (format "git@%s:%s.git" host fork)) + ((string-prefix-p "https://" url) + (format "https://%s/%s.git" host fork)) + ((string-prefix-p "git://" url) + (format "git://%s/%s.git" host fork)) + ((string-prefix-p "http://" url) + (format "http://%s/%s.git" host fork)) + ((error "%s has an unexpected format" url)))))))) + +;;;###autoload +(defun forge-checkout-pullreq (pullreq) + "Create, configure and checkout a new branch from a pull-request. +Please see the manual for more information." + (interactive (list (forge-read-pullreq "Checkout pull request" t))) + (magit--checkout (forge--branch-pullreq (forge-get-pullreq pullreq))) + (magit-refresh)) + +;;;###autoload +(defun forge-checkout-worktree (path pullreq) + "Create, configure and checkout a new worktree from a pull-request. +This is like `forge-checkout-pullreq', except that it also +creates a new worktree. Please see the manual for more +information." + (interactive + (let ((id (forge-read-pullreq "Checkout pull request" t))) + (list (funcall forge-checkout-worktree-read-directory-function + (forge-get-pullreq id)) + id))) + (when (and (file-exists-p path) + (not (and (file-directory-p path) + (length= (directory-files path) 2)))) + (user-error "%s already exists and isn't empty" path)) + (magit-worktree-checkout path + (forge--branch-pullreq (forge-get-pullreq pullreq)))) + +(defun forge-checkout-worktree-default-read-directory-function (pullreq) + (with-slots (number head-ref) pullreq + (let ((path (read-directory-name + (format "Checkout #%s in new worktree: " number) + (file-name-directory + (directory-file-name default-directory)) + nil nil + (let ((branch (forge--pullreq-branch-internal pullreq))) + (if (string-match-p "\\`pr-[0-9]+\\'" branch) + (number-to-string number) + (format "%s-%s" number + (string-replace "/" "-" head-ref))))))) + (when (equal path "") + (user-error "The empty string isn't a valid path")) + path))) + +;;; Marks + +(defun forge-create-mark (name face description) + "Define a new mark that topics can be marked with." + (interactive + (list (read-string "Name: ") + (magit-read-char-case "Set appearance using " nil + (?n "a face [n]ame" + (read-face-name "Face name: ")) + (?s "face [s]exp" + (read-from-minibuffer + "Face sexp: " + "(:background \"\" :foreground \"\" :box t)" + read-expression-map t))) + (let ((str (read-string "Description: "))) + (and (not (equal str "")) str)))) + (forge-sql [:insert-into mark :values $v1] + (vector nil (forge--uuid) name face description))) + +(defun forge-edit-mark (id name face description) + "Define a new mark that topics can be marked with." + (interactive + (pcase-let ((`(,id ,name ,face ,description) + (forge-read-mark "Edit mark"))) + (list id + (read-string "Name: " name) + (magit-read-char-case "Set appearance using " nil + (?n "a face [n]ame" + (read-face-name "Face name: " (and (symbolp face) face))) + (?s "face [s]exp" + (read-from-minibuffer + "Face sexp: " + (if (listp face) + (format "%S" face) + "(:background \"\" :foreground \"\" :box t)") + read-expression-map t))) + (let ((str (read-string "Description: " nil nil description))) + (and (not (equal str "")) str))))) + (forge-sql [:update mark + :set (= [name face description] $v1) + :where (= id $s2)] + (vector name face description) id)) + +(defun forge-read-mark (prompt) + "Read a topic. Return (ID NAME FACE DESCRIPTION)." + (let* ((marks (forge-sql [:select [id name face description] :from mark])) + (name (completing-read prompt (mapcar #'cadr marks) nil t))) + (--first (equal (cadr it) name) marks))) + +(defun forge-read-marks (prompt &optional topic) + "Read multiple mark names and return the respective ids." + (let ((marks (forge-sql [:select [name id] :from mark])) + (crm-separator ",")) + (--map (cadr (assoc it marks)) + (magit-completing-read-multiple + prompt (mapcar #'car marks) nil t + (and topic + (mapconcat #'car (closql--iref topic 'marks) ",")))))) + +(defun forge-toggle-mark (mark) + "Toggle MARK for the current topic." + (if-let ((topic (forge-current-topic))) + (let* ((value (mapcar #'car (closql--iref topic 'marks))) + (value (if (member mark value) + (delete mark value) + (cons mark value))) + (marks (forge-sql [:select [name id] :from mark]))) + (oset topic marks (--map (cadr (assoc it marks)) value)) + (magit-refresh)) + (user-error "There is no topic at point"))) + +;;; Fork + +;;;###autoload +(defun forge-fork (fork remote) + "Fork the current repository to FORK and add it as a REMOTE. +If the fork already exists, then that isn't an error; the remote +is added anyway. Currently this only supports Github and Gitlab." + (interactive + (let ((fork (magit-completing-read "Fork to" + (mapcar #'car forge-owned-accounts)))) + (list fork + (read-string "Remote name: " + (or (plist-get (cdr (assoc fork forge-owned-accounts)) + 'remote-name) + fork))))) + (let ((repo (forge-get-repository 'stub))) + (forge--fork-repository repo fork) + (magit-remote-add remote + (magit-clone--format-url (oref repo githost) fork + (oref repo name)) + (list "--fetch")))) + +;;; Misc + +(transient-define-infix forge-forge.remote () + "Change the local value of the `forge.remote' Git variable." + :class 'magit--git-variable:choices + :variable "forge.remote" + :choices #'magit-list-remotes + :default (lambda (_) (forge--get-remote t))) + +;;;###autoload +(defun forge-list-notifications () + "List notifications." + (interactive) + (forge-notifications-setup-buffer)) + +(transient-define-suffix forge-toggle-display-in-status-buffer () + "Toggle whether to display topics in the current status buffer." + :description (lambda () + (if forge-display-in-status-buffer + "hide all topics" + "display topics")) + (interactive) + (setq forge-display-in-status-buffer (not forge-display-in-status-buffer)) + (magit-refresh)) + +(transient-define-suffix forge-toggle-closed-visibility () + "Toggle whether to display recently closed topics. +This only affect the current status buffer." + :description (lambda () + (if (or (atom forge-topic-list-limit) + (> (cdr forge-topic-list-limit) 0)) + "hide closed topics" + "display recently closed topics")) + :inapt-if-not (lambda () forge-display-in-status-buffer) + (interactive) + (magit-repository-local-delete (list 'forge-ls-recent-topics 'issue)) + (magit-repository-local-delete (list 'forge-ls-recent-topics 'pullreq)) + (make-local-variable 'forge-topic-list-limit) + (if (atom forge-topic-list-limit) + (setq forge-topic-list-limit (cons forge-topic-list-limit 5)) + (setcdr forge-topic-list-limit (* -1 (cdr forge-topic-list-limit)))) + (magit-refresh)) + +(transient-define-infix forge-forge.graphqlItemLimit () + "Change the maximum number of GraphQL entities to pull at once." + :class 'magit--git-variable + :variable "forge.graphqlItemLimit" + :reader #'read-string + :default (lambda () (number-to-string ghub-graphql-items-per-request))) + +;;;###autoload +(defun forge-add-pullreq-refspec () + "Configure Git to fetch all pull-requests. +This is done by adding \"+refs/pull/*/head:refs/pullreqs/*\" +to the value of `remote.REMOTE.fetch', where REMOTE is the +upstream remote. Also fetch from REMOTE." + (interactive) + (let* ((repo (forge-get-repository 'stub)) + (remote (oref repo remote)) + (fetch (magit-get-all "remote" remote "fetch")) + (refspec (oref repo pullreq-refspec))) + (if (member refspec fetch) + (message "Pull-request refspec is already active") + (magit-call-git "config" "--add" + (format "remote.%s.fetch" remote) + refspec) + (magit-git-fetch remote (magit-fetch-arguments))))) + +(defun forge--pullreq-refspec () + (let* ((repo (forge-get-repository 'stub)) + (remote (oref repo remote)) + (fetch (magit-get-all "remote" remote "fetch")) + (refspec (oref repo pullreq-refspec))) + (car (member refspec fetch)))) + +;;;###autoload +(defun forge-add-repository (url) + "Add a repository to the database. +Offer to either pull topics (now and in the future) or to only +pull individual topics when the user invokes `forge-pull-topic'." + (declare (interactive-only t)) + (interactive + (let ((str (magit-read-string-ns + "Add repository to database (url or name)" + (and-let* ((repo (forge-get-repository 'stub)) + (remote (oref repo remote))) + (magit-git-string "remote" "get-url" remote))))) + (if (string-match-p "\\(://\\|@\\)" str) + (list str) + (list (magit-clone--name-to-url str))))) + (if (forge-get-repository url nil 'full) + (user-error "%s is already tracked in Forge database" url) + (let ((repo (forge-get-repository url nil 'create))) + (oset repo sparse-p nil) + (magit-read-char-case "Pull " nil + (?a "[a]ll topics" + (forge-pull repo)) + (?i "[i]ndividual topics (useful for casual contributors)" + (oset repo selective-p t) + (forge--pull repo nil)))))) + +;;;###autoload +(defun forge-add-user-repositories (host user) + "Add all of USER's repositories from HOST to the database. +This may take a while. Only Github is supported at the moment." + (interactive + (list (forge-read-host "Add repositories from Github host" + 'forge-github-repository) + (read-string "User: "))) + (forge--add-user-repos 'forge-github-repository host user)) + +;;;###autoload +(defun forge-add-organization-repositories (host organization) + "Add all of ORGANIZATION's repositories from HOST to the database. +This may take a while. Only Github is supported at the moment." + (interactive + (list (forge-read-host "Add repositories from Github host" + 'forge-github-repository) + (read-string "Organization: "))) + (forge--add-organization-repos 'forge-github-repository host organization)) + +;;;###autoload +(defun forge-merge (pullreq method) + "Merge the current pull-request using METHOD using the forge's API. + +If there is no current pull-request or with a prefix argument, +then read pull-request PULLREQ to visit instead. + +Use of this command is discouraged. Unless the remote repository +is configured to disallow that, you should instead merge locally +and then push the target branch. Forges detect that you have +done that and respond by automatically marking the pull-request +as merged." + (interactive + (list (forge-read-pullreq "Merge pull-request" t) + (if (forge--childp (forge-get-repository t) 'forge-gitlab-repository) + (magit-read-char-case "Merge method " t + (?m "[m]erge" 'merge) + (?s "[s]quash" 'squash)) + (magit-read-char-case "Merge method " t + (?m "[m]erge" 'merge) + (?s "[s]quash" 'squash) + (?r "[r]ebase" 'rebase))))) + (let ((pullreq (forge-get-pullreq pullreq))) + (forge--merge-pullreq (forge-get-repository pullreq) + pullreq + (magit-rev-hash + (forge--pullreq-branch-internal pullreq)) + method)) + (forge-pull)) + +;;;###autoload +(defun forge-remove-repository (host owner name) + "Remove a repository from the database." + (interactive + (pcase-let ((`(,githost ,owner ,name) + (forge-read-repository "Remove repository from db"))) + (if (yes-or-no-p + (format "Do you really want to remove \"%s/%s @%s\" from the db? " + owner name githost)) + (list githost owner name) + (user-error "Abort")))) + (closql-delete (forge-get-repository (list host owner name))) + (magit-refresh)) + +;;;###autoload +(defun forge-remove-topic-locally (topic) + "Remove a topic from the local database only. +Due to how the supported APIs work, it would be too expensive to +automatically remove topics from the local database that were +removed from the forge. The purpose of this command is to allow +you to manually clean up the local database." + (interactive (list (forge-read-topic "Delete topic LOCALLY only"))) + (setq topic (forge-get-topic topic)) + (closql-delete topic) + (if (and (derived-mode-p 'forge-topic-mode) + (eq (oref topic id) + (oref forge-buffer-topic id))) + (kill-buffer (current-buffer)) + (magit-refresh))) + +;;;###autoload +(defun forge-rename-default-branch () + "Rename the default branch to NEWNAME. +Change the name on the upstream remote and locally, and update +the upstream remotes of local branches accordingly." + (interactive) + (let* ((repo (forge-get-repository 'full)) + (_ (unless (forge-github-repository-p repo) + (user-error "Updating default branch not supported for forge `%s'" + (oref repo forge)))) + (remote (or (and (fboundp 'forge--get-remote) + (forge--get-remote)) + (magit-get-some-remote) + (user-error "No remote configured"))) + (symref (format "refs/remotes/%s/HEAD" remote)) + (oldhead (progn + (message "Determining old default branch...") + (magit-git "fetch" "--prune") + (magit-git "remote" "set-head" "--auto" remote) + (message "Determining old default branch...done") + (magit-git-string "symbolic-ref" "--short" symref))) + (oldname (if oldhead + (cdr (magit-split-branch-name oldhead)) + (error "Cannot determine old default branch"))) + (default (and (not (equal oldname "main")) "main")) + (newname (read-string + (format "Rename default branch `%s' to%s: " + oldname + (if default (format " (default: %s)" default) "")) + nil nil default))) + (message "Renaming default branch...") + (forge--set-default-branch repo newname oldname) + (magit-refresh) + (message "Renaming default branch...done"))) + +;;;###autoload +(defun forge-reset-database () + "Move the current database file to the trash. +This is useful after the database scheme has changed, which will +happen a few times while the forge functionality is still under +heavy development." + (interactive) + (when (and (file-exists-p forge-database-file) + (yes-or-no-p "Really trash Forge's database file? ")) + (when-let ((db (forge-db t))) + (emacsql-close db)) + (delete-file forge-database-file t) + (magit-refresh))) + +(defun forge-enable-sql-logging () + "Enable logging Forge's SQL queries." + (interactive) + (let ((db (forge-db))) + (emacsql-enable-debugging db) + (switch-to-buffer-other-window (emacsql-log-buffer (oref db connection))))) + +(magit-define-section-jumper forge-jump-to-pullreqs "Pull requests" pullreqs) +(magit-define-section-jumper forge-jump-to-issues "Issues" issues) + +;;; _ +(provide 'forge-commands) +;;; forge-commands.el ends here diff --git a/elpa/forge-20230711.1157/forge-core.el b/elpa/forge-20230711.1157/forge-core.el new file mode 100644 index 00000000..812c8391 --- /dev/null +++ b/elpa/forge-20230711.1157/forge-core.el @@ -0,0 +1,370 @@ +;;; forge-core.el --- Core functionality -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 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 'subr-x) + +(require 'transient) + +(require 'forge-db) + +(eval-when-compile + (cl-pushnew 'id eieio--known-slot-names) + (cl-pushnew 'name eieio--known-slot-names) + (cl-pushnew 'owner eieio--known-slot-names) + (cl-pushnew 'number eieio--known-slot-names)) + +;;; Options + +(defgroup forge nil + "Options concerning Git forges." + :group 'magit) + +(defgroup forge-faces nil + "Faces concerning Git forges." + :group 'forge + :group 'magit-faces) + +(defcustom forge-alist + '(;; Forges + ("github.com" "api.github.com" + "github.com" forge-github-repository) + ("gitlab.com" "gitlab.com/api/v4" + "gitlab.com" forge-gitlab-repository) + ("salsa.debian.org" "salsa.debian.org/api/v4" + "salsa.debian.org" forge-gitlab-repository) + ("framagit.org" "framagit.org/api/v4" + "framagit.org" forge-gitlab-repository) + ("gitlab.gnome.org" "gitlab.gnome.org/api/v4" + "gitlab.gnome.org" forge-gitlab-repository) + ;; Forges (API unsupported) + ("codeberg.org" "codeberg.org/api/v1" + "codeberg.org" forge-gitea-repository) + ("code.orgmode.org" "code.orgmode.org/api/v1" + "code.orgmode.org" forge-gogs-repository) + ("bitbucket.org" "api.bitbucket.org/2.0" + "bitbucket.org" forge-bitbucket-repository) + ;; Semi-Forges + ("git.savannah.gnu.org" nil + "git.savannah.gnu.org" forge-cgit**-repository) + ("git.kernel.org" nil + "git.kernel.org" forge-cgit-repository) + ("repo.or.cz" nil + "repo.or.cz" forge-repoorcz-repository) + ("git.suckless.org" nil + "git.suckless.org" forge-stagit-repository) + ("git.sr.ht" nil + "git.sr.ht" forge-srht-repository)) + "List of Git forges. + +Each entry has the form (GITHOST APIHOST ID CLASS). + +GITHOST is matched against the host part of Git remote urls + using `forge--url-regexp' to identify the forge. +APIHOST is the api endpoint of the forge's api. +ID is used to identify the forge in the local database. +CLASS is the class to be used for repository from the forge. + +GITHOST and APIHOST can be changed, but ID and CLASS are final. +If you change ID, then the identity of every repository from +that forge changes. If you change CLASS, then things start +falling apart. + +There can be multiple elements that only differ in GITHOST. +Among those, the canonical element should come first. Any +elements that have the same APIHOST must also have the same +ID, and vice-versa. + +Complications: + +* When connecting to a Github Enterprise edition whose REST + API's end point is \"/v3\" and whose GraphQL API's + end point is \"/graphql\", then use \"/v3\" as + APIHOST. This is a historic accident. See issue #174. + +* This variable does not account for the possibility that the + git repository does not use the same address as the web + interface. That is another historic accident and if many + users are affected by it, we might have to fix it properly. + If you would like that, comment on issue #532. + + For now a workaround has to be used. Assuming the web + interface is available at \"example.com\" and the repository + is at \"ssh.example.com\", use \"example.com\" as GITHOST and + add something like this to \".gitconfig\": + + [url \"git@ssh.example.com\"] + insteadOf = git@example.com" + :package-version '(forge . "0.1.0") + :group 'forge + :type '(repeat (list (string :tag "Git host") + (choice (string :tag "API endpoint") + (const :tag "No API" nil)) + (string :tag "ID") + (symbol :tag "Repository class")))) + +(defcustom forge-pull-notifications nil + "Whether `forge-pull' also fetches notifications. +If this is nil, then `forge-pull-notifications' has to be used." + :package-version '(forge . "0.2.0") + :group 'forge + :type 'boolean) + +;;; Core + +(defclass forge-object (closql-object) () :abstract t) + +(cl-defgeneric forge-get-parent (object) + "Return the parent object of OBJECT. +The hierarchy is repository > topic > post. +For other objects return nil.") + +(cl-defgeneric forge-get-repository (demand) + "Return a forge repository object or nil, or signal an error. + +The DEMAND argument controls what to do when the object isn't +stored in the database yet, or if it is marked as sparse. The +valid values are: + +* `nil' If the repository is stored in the database then return + it, even if it is sparse. Otherwise return nil. + +* `t' If the repository isn't stored in the database or if the + object is sparse, then signal an error, informing the user + that `this-command' cannot be run until the repository has + been pulled. + +* `full' If the repository is stored in the database and the + object isn't sparse, then return it. Otherwise return nil. + +* `stub' If the repository is stored in the database, then return + it, regardless of whether it is sparse or not. Otherwise create + a new object and return it, but do not store it in the database. + In the latter case it is assumed that the caller does not need + the `id' and `forge-id' slots whose value differ from what they + would be if the object were retrieved from the database. + +* `create' This value is only intended to be used by commands + that fetch data from the API. If the repository is stored in + the database, then return that, regardless of whether the + object is sparse or not. If the repository is not stored in the + database, then make an API request to determine the ID used on + the forge, derive our own ID from that, and store a new sparse + object in the database and return it. + +If DEMAND is t, `stub' or `create', then also signal an error if +the repository cannot be determined because there is no matching +entry in `forge-alist'. + +Also update the object's `apihost', `githost' and `remote' slots +according to the respective entry in `forge-alist' and the REMOTE +argument. + +Also see info node `(forge) Repository Detection'.") + +(cl-defgeneric forge-get-topic () + "Return a forge issue or pullreq object.") + +(cl-defgeneric forge-get-issue () + "Return a forge issue object.") + +(cl-defgeneric forge-get-pullreq () + "Return a forge pullreq object.") + +(cl-defgeneric forge-get-url (obj) + "Return the URL for a forge object.") + +(cl-defgeneric forge-browse (obj) + "Visit the URL corresponding to a forge object in a browser." + (browse-url (forge-get-url obj))) + +(cl-defgeneric forge-visit (obj) + "View a forge object in a separate buffer.") + +(cl-defgeneric forge--object-id (class &rest args) + "Return the database id for the CLASS object specified by ARGS.") + +(cl-defgeneric forge--repository-ids (class host owner name &optional stub) + "Return the database and forge ids for the specified CLASS object.") + +(cl-defmethod magit-section-ident-value ((obj forge-object)) + (oref obj id)) + +;;; Utilities + +(defmacro forge--childp (obj type) + "Somewhat similar to `cl-typep' but only for (possibly unknown) classes. +TYPE is evaluated at macro-expansion time but unlike with +`cl-typep' the respective class does not have to be defined +at that time." + (let ((fn (intern (concat (symbol-name (eval type)) "--eieio-childp")))) + `(and (fboundp ',fn) (,fn ,obj)))) + +(defun forge--set-id-slot (repo object slot rows) + (let ((repo-id (oref repo id))) + (closql-oset + object slot + (mapcar (lambda (val) + (forge--object-id repo-id + (if (atom val) val (alist-get 'id val)))) + rows)))) + +(cl-defgeneric forge--format (object slot &optional spec)) + +(cl-defmethod forge--format ((remote string) slot &optional spec) + (if-let ((parts (forge--split-remote-url remote))) + (forge--format + (forge-get-repository 'stub remote) slot + (pcase-let* ((`(,host ,owner ,name) parts) + (path (if owner (concat owner "/" name) name))) + `(,@spec + (?h . ,host) + (?o . ,owner) + (?n . ,name) + (?p . ,path) + (?P . ,(string-replace "/" "%2F" path))))) + (user-error "Cannot browse non-forge remote %s" remote))) + +(defun forge--url-regexp () + (concat "\\`\\(?:git://\\|" + "[^/@]+@\\|" + "\\(?:ssh\\|ssh\\+git\\|git\\+ssh\\)://\\(?:[^/@]+@\\)?\\|" + "https?://\\(?:[^/@]+@\\)?\\)?" + (regexp-opt (mapcar #'car forge-alist) t) + "\\(?::[0-9]+\\)?" + "\\(?:/\\|:/?\\)" + "\\(.+?\\)" + "\\(?:\\.git\\|/\\)?\\'")) + +(defun forge--split-remote-url (remote) + (and-let* ((url (magit-git-string "remote" "get-url" remote))) + (forge--split-url url))) + +(defun forge--split-url (url) + (and (string-match (forge--url-regexp) url) + (and-let* ((host (match-string 1 url)) + (path (match-string 2 url)) + (path (forge--split-url-path + (nth 3 (assoc host forge-alist)) + path))) + (cons host path)))) + +(cl-defmethod forge--split-url-path + ((_class (subclass forge-repository)) path) + (and (string-match "\\`\\([^/]+\\)/\\([^/]+?\\)\\'" path) + (list (match-string 1 path) + (match-string 2 path)))) + +(cl-defmethod forge--split-url-path + ((_class (subclass forge-noapi-repository)) path) + (and (string-match "\\`\\(?:~?\\(.+\\)/\\)?\\([^/]+?\\)\\'" path) + (list (match-string 1 path) + (match-string 2 path)))) + +(defun forge--url-p (url) + (save-match-data + (and (string-match (forge--url-regexp) url) + (nth 2 (assoc (match-string 1 url) forge-alist))))) + +(defun forge--forge-remote-p (remote) + (and-let* ((url (magit-git-string "remote" "get-url" remote))) + (forge--url-p url))) + +(defun forge--url-equal (urlA urlB) + (or (equal urlA urlB) + (save-match-data + (let ((re (forge--url-regexp)) + hostA repoA hostB repoB) + (and (when (string-match re urlA) + (setq hostA (match-string 1 urlA)) + (setq repoA (match-string 2 urlA))) + (when (string-match re urlB) + (setq hostB (match-string 1 urlB)) + (setq repoB (match-string 2 urlB))) + (equal repoA repoB) + (equal (cl-caddr (assoc hostA forge-alist)) + (cl-caddr (assoc hostB forge-alist)))))))) + +(cl-defmethod forge--format-resource ((object forge-object) resource) + (save-match-data + (setq resource + (replace-regexp-in-string + ":\\([^/]+\\)" + (lambda (str) + (let ((slot (intern (substring str 1)))) + (or (and-let* + ((v (ignore-errors + (cl-case slot + (repo (oref object name)) + (project (concat (string-replace + "/" "%2F" (oref object owner)) + "%2F" + (oref object name))) + (topic (and (forge--childp object 'forge-topic) + (oref object number))) + (t (eieio-oref object slot)))))) + (format "%s" v)) + str))) + resource t t)) + (if (string-match ":[^/]*" resource) + (if-let ((parent (ignore-errors (forge-get-parent object)))) + (forge--format-resource parent resource) + (error "Cannot resolve %s for a %s" + (match-string 0 resource) + (eieio-object-class object))) + resource))) + +;; This is a copy of `org-id-uuid'. +(defun forge--uuid () + "Return string with random (version 4) UUID." + (let ((rnd (md5 (format "%s%s%s%s%s%s%s" + (random) + (current-time) + (user-uid) + (emacs-pid) + (user-full-name) + user-mail-address + (recent-keys))))) + (format "%s-%s-4%s-%s%s-%s" + (substring rnd 0 8) + (substring rnd 8 12) + (substring rnd 13 16) + (format "%x" + (logior + #b10000000 + (logand + #b10111111 + (string-to-number + (substring rnd 16 18) 16)))) + (substring rnd 18 20) + (substring rnd 20 32)))) + +;;; _ +(provide 'forge-core) +;;; forge-core.el ends here diff --git a/elpa/forge-20230711.1157/forge-db.el b/elpa/forge-20230711.1157/forge-db.el new file mode 100644 index 00000000..237989c2 --- /dev/null +++ b/elpa/forge-20230711.1157/forge-db.el @@ -0,0 +1,446 @@ +;;; forge-db.el --- Database implementation -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 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-get-issue "forge-core") +(declare-function forge-get-pullreq "forge-core") +(declare-function forge--object-id "forge-core") + +(eval-when-compile + (cl-pushnew 'value eieio--known-slot-names)) + +;;; Options + +(defcustom forge-database-file + (expand-file-name "forge-database.sqlite" user-emacs-directory) + "The file used to store the forge database." + :package-version '(forge . "0.1.0") + :group 'forge + :type 'file) + +;;; Core + +(defclass forge-database (closql-database) + ((name :initform "Forge") + (object-class :initform 'forge-repository) + (file :initform 'forge-database-file) + (schemata :initform 'forge--db-table-schemata) + (version :initform 9))) + +(defvar forge--override-connection-class nil) + +(defun forge-db (&optional livep) + (closql-db 'forge-database livep forge--override-connection-class)) + +(defun forge-sql (sql &rest args) + (if (stringp sql) + (emacsql (forge-db) (apply #'format sql args)) + (apply #'emacsql (forge-db) sql args))) + +(defun forge-connect-database-once () + "Try to connect Forge database on first use of `magit-status' only." + (remove-hook 'magit-status-mode-hook #'forge-connect-database-once) + (forge-db)) +(add-hook 'magit-status-mode-hook #'forge-connect-database-once) + +;;; Schemata + +(defconst forge--db-table-schemata + '((repository + [(class :not-null) + (id :not-null :primary-key) + forge-id + forge + owner + name + apihost + githost + remote + sparse-p + created + updated + pushed + parent + description + homepage + default-branch + archived-p + fork-p + locked-p + mirror-p + private-p + issues-p + wiki-p + stars + watchers + (assignees :default eieio-unbound) + (forks :default eieio-unbound) + (issues :default eieio-unbound) + (labels :default eieio-unbound) + (revnotes :default eieio-unbound) + (pullreqs :default eieio-unbound) + selective-p + worktree + (milestones :default eieio-unbound)]) + + (assignee + [(repository :not-null) + (id :not-null :primary-key) + login + name + forge-id] ; Needed for Gitlab. + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (fork + [(parent :not-null) + (id :not-null :primary-key) + owner + name] + (:foreign-key + [parent] :references repository [id] + :on-delete :cascade)) + + (issue + [(class :not-null) + (id :not-null :primary-key) + repository + number + state + author + title + created + updated + closed + unread-p + locked-p + milestone + body + (assignees :default eieio-unbound) + (cards :default eieio-unbound) + (edits :default eieio-unbound) + (labels :default eieio-unbound) + (participants :default eieio-unbound) + (posts :default eieio-unbound) + (reactions :default eieio-unbound) + (timeline :default eieio-unbound) + (marks :default eieio-unbound) + note + their-id] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (issue-assignee + [(issue :not-null) + (id :not-null)] + (:foreign-key + [issue] :references issue [id] + :on-delete :cascade)) + + (issue-label + [(issue :not-null) + (id :not-null)] + (:foreign-key + [issue] :references issue [id] + :on-delete :cascade) + (:foreign-key + [id] :references label [id] + :on-delete :cascade)) + + (issue-mark + [(issue :not-null) + (id :not-null)] + (:foreign-key + [issue] :references issue [id] + :on-delete :cascade) + (:foreign-key + [id] :references mark [id] + :on-delete :cascade)) + + (issue-post + [(class :not-null) + (id :not-null :primary-key) + issue + number + author + created + updated + body + (edits :default eieio-unbound) + (reactions :default eieio-unbound)] + (:foreign-key + [issue] :references issue [id] + :on-delete :cascade)) + + (label + [(repository :not-null) + (id :not-null :primary-key) + name + color + description] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (mark + [;; For now this is always nil because it seems more useful to + ;; share marks between repositories. We cannot omit this slot + ;; though because `closql--iref' expects `id' to be the second + ;; slot. + repository + (id :not-null :primary-key) + name + face + description]) + + (milestone + [(repository :not-null) + (id :not-null :primary-key) + number + title + created + updated + due + closed + description] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (notification + [(class :not-null) + (id :not-null :primary-key) + thread-id + repository + forge + reason + unread-p + last-read + updated + title + type + topic + url] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (pullreq + [(class :not-null) + (id :not-null :primary-key) + repository + number + state + author + title + created + updated + closed + merged + unread-p + locked-p + editable-p + cross-repo-p + base-ref + base-repo + head-ref + head-user + head-repo + milestone + body + (assignees :default eieio-unbound) + (cards :default eieio-unbound) + (commits :default eieio-unbound) + (edits :default eieio-unbound) + (labels :default eieio-unbound) + (participants :default eieio-unbound) + (posts :default eieio-unbound) + (reactions :default eieio-unbound) + (review-requests :default eieio-unbound) + (reviews :default eieio-unbound) + (timeline :default eieio-unbound) + (marks :default eieio-unbound) + note + base-rev + head-rev + draft-p + their-id] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (pullreq-assignee + [(pullreq :not-null) + (id :not-null)] + (:foreign-key + [pullreq] :references pullreq [id] + :on-delete :cascade)) + + (pullreq-label + [(pullreq :not-null) + (id :not-null)] + (:foreign-key + [pullreq] :references pullreq [id] + :on-delete :cascade) + (:foreign-key + [id] :references label [id] + :on-delete :cascade)) + + (pullreq-mark + [(pullreq :not-null) + (id :not-null)] + (:foreign-key + [pullreq] :references pullreq [id] + :on-delete :cascade) + (:foreign-key + [id] :references mark [id] + :on-delete :cascade)) + + (pullreq-post + [(class :not-null) + (id :not-null :primary-key) + pullreq + number + author + created + updated + body + (edits :default eieio-unbound) + (reactions :default eieio-unbound)] + (:foreign-key + [pullreq] :references pullreq [id] + :on-delete :cascade)) + + (pullreq-review-request + [(pullreq :not-null) + (id :not-null)] + (:foreign-key + [pullreq] :references pullreq [id] + :on-delete :cascade)) + + (revnote + [(class :not-null) + (id :not-null :primary-key) + repository + commit + file + line + author + body] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)))) + +(cl-defmethod closql--db-update-schema ((db forge-database)) + (let ((code-version (oref-default 'forge-database version)) + (version (closql--db-get-version db))) + (when (< version code-version) + (forge--backup-database db)) + (closql-with-transaction db + (when (= version 2) + (message "Upgrading Forge database from version 2 to 3...") + (emacsql db [:create-table pullreq-review-request $S1] + (cdr (assq 'pullreq-review-request forge--db-table-schemata))) + (closql--db-set-version db (setq version 3)) + (message "Upgrading Forge database from version 2 to 3...done")) + (when (= version 3) + (message "Upgrading Forge database from version 3 to 4...") + (emacsql db [:drop-table notification]) + (pcase-dolist (`(,table . ,schema) forge--db-table-schemata) + (when (memq table '(notification + mark issue-mark pullreq-mark)) + (emacsql db [:create-table $i1 $S2] table schema))) + (emacsql db [:alter-table issue :add-column marks :default $s1] 'eieio-unbound) + (emacsql db [:alter-table pullreq :add-column marks :default $s1] 'eieio-unbound) + (closql--db-set-version db (setq version 4)) + (message "Upgrading Forge database from version 3 to 4...done")) + (when (= version 4) + (message "Upgrading Forge database from version 4 to 5...") + (emacsql db [:alter-table repository :add-column selective-p :default nil]) + (closql--db-set-version db (setq version 5)) + (message "Upgrading Forge database from version 4 to 5...done")) + (when (= version 5) + (message "Upgrading Forge database from version 5 to 6...") + (emacsql db [:alter-table repository :add-column worktree :default nil]) + (closql--db-set-version db (setq version 6)) + (message "Upgrading Forge database from version 5 to 6...done")) + (when (= version 6) + (message "Upgrading Forge database from version 6 to 7...") + (emacsql db [:alter-table issue :add-column note :default nil]) + (emacsql db [:alter-table pullreq :add-column note :default nil]) + (emacsql db [:create-table milestone $S1] + (cdr (assq 'milestone forge--db-table-schemata))) + (emacsql db [:alter-table repository :add-column milestones :default $s1] + 'eieio-unbound) + (pcase-dolist (`(,repo-id ,issue-id ,milestone) + (emacsql db [:select [repository id milestone] + :from issue + :where (notnull milestone)])) + (unless (stringp milestone) + (oset (forge-get-issue issue-id) milestone + (forge--object-id repo-id (cdar milestone))))) + (pcase-dolist (`(,repo-id ,pullreq-id ,milestone) + (emacsql db [:select [repository id milestone] + :from pullreq + :where (notnull milestone)])) + (unless (stringp milestone) + (oset (forge-get-pullreq pullreq-id) milestone + (forge--object-id repo-id (cdar milestone))))) + (closql--db-set-version db (setq version 7)) + (message "Upgrading Forge database from version 6 to 7...done")) + (when (= version 7) + (message "Upgrading Forge database from version 7 to 8...") + (emacsql db [:alter-table pullreq :add-column base-rev :default nil]) + (emacsql db [:alter-table pullreq :add-column head-rev :default nil]) + (emacsql db [:alter-table pullreq :add-column draft-p :default nil]) + (closql--db-set-version db (setq version 8)) + (message "Upgrading Forge database from version 7 to 8...done")) + (when (= version 8) + (message "Upgrading Forge database from version 8 to 9...") + (emacsql db [:alter-table pullreq :add-column their-id :default nil]) + (emacsql db [:alter-table issue :add-column their-id :default nil]) + (closql--db-set-version db (setq version 9)) + (message "Upgrading Forge database from version 8 to 9...done"))) + (cl-call-next-method))) + +(defun forge--backup-database (db) + (let ((dst (concat (file-name-sans-extension forge-database-file) + (format "-v%s" (caar (emacsql (oref db connection) + [:pragma user-version]))) + (format-time-string "-%Y%m%d-%H%M") + ".sqlite"))) + (message "Copying Forge database to %s..." dst) + (copy-file forge-database-file dst) + (message "Copying Forge database to %s...done" dst))) + +;;; _ +(provide 'forge-db) +;;; forge-db.el ends here diff --git a/elpa/forge-20230711.1157/forge-gitea.el b/elpa/forge-20230711.1157/forge-gitea.el new file mode 100644 index 00000000..31be47f7 --- /dev/null +++ b/elpa/forge-20230711.1157/forge-gitea.el @@ -0,0 +1,47 @@ +;;; forge-gitea.el --- Gitea support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 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-20230711.1157/forge-github.el b/elpa/forge-20230711.1157/forge-github.el new file mode 100644 index 00000000..e2695278 --- /dev/null +++ b/elpa/forge-20230711.1157/forge-github.el @@ -0,0 +1,801 @@ +;;; forge-github.el --- Github support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 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/*"))) + +;;; Pull +;;;; Repository + +(cl-defmethod forge--pull ((repo forge-github-repository) until + &optional callback) + (let ((buf (current-buffer)) + (dir default-directory) + (selective-p (oref repo selective-p)) + (ghub-graphql-items-per-request + (string-to-number + (or (magit-get "forge.graphqlItemLimit") "100")))) + (ghub-fetch-repository + (oref repo owner) + (oref repo name) + (lambda (data) + (forge--msg repo t t "Pulling REPO") + (forge--msg repo t nil "Storing REPO") + (closql-with-transaction (forge-db) + (let-alist data + (forge--update-repository repo data) + (forge--update-assignees repo .assignableUsers) + (forge--update-forks repo .forks) + (forge--update-labels repo .labels) + (forge--update-milestones repo .milestones) + (forge--update-issues repo .issues t) + (forge--update-pullreqs repo .pullRequests t) + (forge--update-revnotes repo .commitComments)) + (oset repo sparse-p nil)) + (forge--msg repo t t "Storing REPO") + (cond + (selective-p) + (callback (funcall callback)) + (forge-pull-notifications + (forge--pull-notifications (eieio-object-class repo) + (oref repo githost) + (lambda () (forge--git-fetch buf dir repo)))) + (t (forge--git-fetch buf dir repo)))) + `((issues-until . ,(forge--topics-until repo until 'issue)) + (pullRequests-until . ,(forge--topics-until repo until 'pullreq))) + :host (oref repo apihost) + :auth 'forge + :sparse selective-p))) + +(cl-defmethod forge--pull-topic ((repo forge-github-repository) + (topic forge-topic)) + (let ((buffer (current-buffer)) + (fetch #'ghub-fetch-issue) + (update #'forge--update-issue) + (errorback (lambda (err _headers _status _req) + (when (equal (cdr (assq 'type (cadr err))) "NOT_FOUND") + (forge--pull-topic + repo (forge-pullreq :repository (oref repo id) + :number (oref topic number))))))) + (when (cl-typep topic 'forge-pullreq) + (setq fetch #'ghub-fetch-pullreq) + (setq update #'forge--update-pullreq) + (setq errorback nil)) + (funcall + fetch + (oref repo owner) + (oref repo name) + (oref topic number) + (lambda (data) + (funcall update repo data nil) + (with-current-buffer + (if (buffer-live-p buffer) buffer (current-buffer)) + (magit-refresh))) + nil + :errorback errorback + :host (oref repo apihost) + :auth 'forge))) + +(cl-defmethod forge--update-repository ((repo forge-github-repository) data) + (let-alist data + (oset repo created .createdAt) + (oset repo updated .updatedAt) + (oset repo pushed .pushedAt) + (oset repo parent .parent.nameWithOwner) + (oset repo description .description) + (oset repo homepage (and (not (equal .homepageUrl "")) .homepageUrl)) + (oset repo default-branch .defaultBranchRef.name) + (oset repo archived-p .isArchived) + (oset repo fork-p .isFork) + (oset repo locked-p .isLocked) + (oset repo mirror-p .isMirror) + (oset repo private-p .isPrivate) + (oset repo issues-p .hasIssuesEnabled) + (oset repo wiki-p .hasWikiEnabled) + (oset repo stars .stargazers.totalCount) + (oset repo watchers .watchers.totalCount))) + +(cl-defmethod forge--update-issues ((repo forge-github-repository) data bump) + (closql-with-transaction (forge-db) + (mapc (lambda (e) (forge--update-issue repo e bump)) data))) + +(cl-defmethod forge--update-issue ((repo forge-github-repository) data bump) + (closql-with-transaction (forge-db) + (let-alist data + (let* ((issue-id (forge--object-id 'forge-issue repo .number)) + (issue (or (forge-get-issue repo .number) + (closql-insert + (forge-db) + (forge-issue :id issue-id + :repository (oref repo id) + :number .number))))) + (oset issue id issue-id) + (oset issue their-id .id) + (oset issue state (pcase-exhaustive .state + ("CLOSED" 'closed) + ("OPEN" 'open))) + (oset issue author .author.login) + (oset issue title .title) + (oset issue created .createdAt) + (oset issue updated (cond (bump (or .updatedAt .createdAt)) + ((slot-boundp issue 'updated) + (oref issue updated)) + (t "0"))) + (oset issue closed .closedAt) + (oset issue locked-p .locked) + (oset issue milestone (and .milestone.id + (forge--object-id (oref repo id) + .milestone.id))) + (oset issue body (forge--sanitize-string .body)) + .databaseId ; Silence Emacs 25 byte-compiler. + (dolist (c .comments) + (let-alist c + (closql-insert + (forge-db) + (forge-issue-post + :id (forge--object-id issue-id .databaseId) + :issue issue-id + :number .databaseId + :author .author.login + :created .createdAt + :updated .updatedAt + :body (forge--sanitize-string .body)) + t))) + (when bump + (forge--set-id-slot repo issue 'assignees .assignees) + (unless (magit-get-boolean "forge.kludge-for-issue-294") + (forge--set-id-slot repo issue 'labels .labels))) + issue)))) + +(cl-defmethod forge--update-pullreqs ((repo forge-github-repository) data bump) + (closql-with-transaction (forge-db) + (mapc (lambda (e) (forge--update-pullreq repo e bump)) data))) + +(cl-defmethod forge--update-pullreq ((repo forge-github-repository) data bump) + (closql-with-transaction (forge-db) + (let-alist data + (let* ((pullreq-id (forge--object-id 'forge-pullreq repo .number)) + (pullreq (or (forge-get-pullreq repo .number) + (closql-insert + (forge-db) + (forge-pullreq :id pullreq-id + :repository (oref repo id) + :number .number))))) + (oset pullreq their-id .id) + (oset pullreq state (pcase-exhaustive .state + ("MERGED" 'merged) + ("CLOSED" 'closed) + ("OPEN" 'open))) + (oset pullreq author .author.login) + (oset pullreq title .title) + (oset pullreq created .createdAt) + (oset pullreq updated (cond (bump (or .updatedAt .createdAt)) + ((slot-boundp pullreq 'updated) + (oref pullreq updated)) + (t "0"))) + (oset pullreq closed .closedAt) + (oset pullreq merged .mergedAt) + (oset pullreq draft-p .isDraft) + (oset pullreq locked-p .locked) + (oset pullreq editable-p .maintainerCanModify) + (oset pullreq cross-repo-p .isCrossRepository) + (oset pullreq base-ref .baseRef.name) + (oset pullreq base-rev .baseRefOid) + (oset pullreq base-repo .baseRef.repository.nameWithOwner) + (oset pullreq head-ref .headRef.name) + (oset pullreq head-rev .headRefOid) + (oset pullreq head-user .headRef.repository.owner.login) + (oset pullreq head-repo .headRef.repository.nameWithOwner) + (oset pullreq milestone (and .milestone.id + (forge--object-id (oref repo id) + .milestone.id))) + (oset pullreq body (forge--sanitize-string .body)) + .databaseId ; Silence Emacs 25 byte-compiler. + (dolist (p .comments) + (let-alist p + (closql-insert + (forge-db) + (forge-pullreq-post + :id (forge--object-id pullreq-id .databaseId) + :pullreq pullreq-id + :number .databaseId + :author .author.login + :created .createdAt + :updated .updatedAt + :body (forge--sanitize-string .body)) + t))) + (when bump + (forge--set-id-slot repo pullreq 'assignees .assignees) + (forge--set-id-slot repo pullreq 'review-requests + (--map (cdr (cadr (car it))) + .reviewRequests)) + (unless (magit-get-boolean "forge.kludge-for-issue-294") + (forge--set-id-slot repo pullreq 'labels .labels))) + pullreq)))) + +(cl-defmethod forge--update-revnotes ((repo forge-github-repository) data) + (closql-with-transaction (forge-db) + (mapc (apply-partially #'forge--update-revnote repo) data))) + +(cl-defmethod forge--update-revnote ((repo forge-github-repository) data) + (closql-with-transaction (forge-db) + (let-alist data + (closql-insert + (forge-db) + (forge-revnote + :id (forge--object-id 'forge-revnote repo .id) + :repository (oref repo id) + :commit .commit.oid + :file .path + :line .position + :author .author.login + :body .body) + t)))) + +(cl-defmethod forge--update-assignees ((repo forge-github-repository) data) + (oset repo assignees + (with-slots (id) repo + (mapcar (lambda (row) + (let-alist row + (list (forge--object-id id .id) + .login + .name + .id))) + (delete-dups data))))) + +(cl-defmethod forge--update-forks ((repo forge-github-repository) data) + (oset repo forks + (with-slots (id) repo + (mapcar (lambda (row) + (let-alist row + (nconc (forge--repository-ids + (eieio-object-class repo) + (oref repo githost) + .owner.login + .name) + (list .owner.login + .name)))) + (delete-dups data))))) + +(cl-defmethod forge--update-labels ((repo forge-github-repository) data) + (oset repo labels + (with-slots (id) repo + (mapcar (lambda (row) + (let-alist row + (list (forge--object-id id .id) + .name + (concat "#" (downcase .color)) + .description))) + (delete-dups data))))) + +(cl-defmethod forge--update-milestones ((repo forge-github-repository) data) + (oset repo milestones + (with-slots (id) repo + (mapcar (lambda (row) + (let-alist row + (list (forge--object-id id .id) + .number + .title + .createdAt + .updatedAt + .dueOn + .closedAt + .description))) + (delete-dups data))))) + +;;;; Notifications + +(cl-defmethod forge--pull-notifications + ((_class (subclass forge-github-repository)) githost &optional callback) + ;; The GraphQL API doesn't support notifications and also likes to + ;; timeout for handcrafted requests, forcing us to perform a major + ;; rain dance. + (let ((spec (assoc githost forge-alist))) + (unless spec + (error "No entry for %S in forge-alist" githost)) + (forge--msg nil t nil "Pulling notifications") + (pcase-let* + ((`(,_ ,apihost ,forge ,_) spec) + (notifs (-keep (lambda (data) + ;; Github may return notifications for repos + ;; the user no longer has access to. Trying + ;; to retrieve information for such a repo + ;; leads to an error, which we suppress. See #164. + (with-demoted-errors "forge--pull-notifications: %S" + (forge--ghub-massage-notification + data forge githost))) + (forge--ghub-get nil "/notifications" + '((all . nil)) + :host apihost :unpaginate t))) + (groups (-partition-all 50 notifs)) + (pages (length groups)) + (page 0) + (result nil)) + (cl-labels + ((cb (&optional data _headers _status _req) + (when data + (setq result (nconc result (cdr data)))) + (if groups + (progn (cl-incf page) + (forge--msg nil t nil + "Pulling notifications (page %s/%s)" + page pages) + (ghub--graphql-vacuum + (cons 'query (-keep #'caddr (pop groups))) + nil #'cb nil :auth 'forge :host apihost)) + (forge--msg nil t t "Pulling notifications") + (forge--msg nil t nil "Storing notifications") + (closql-with-transaction (forge-db) + (forge-sql [:delete-from notification + :where (= forge $s1)] forge) + (pcase-dolist (`(,key ,repo ,query ,obj) notifs) + (closql-insert (forge-db) obj) + (forge--zap-repository-cache (forge-get-repository obj)) + (when query + (oset (funcall (if (eq (oref obj type) 'issue) + #'forge--update-issue + #'forge--update-pullreq) + repo (cdr (cadr (assq key result))) nil) + unread-p (oref obj unread-p))))) + (forge--msg nil t t "Storing notifications") + (when callback + (funcall callback))))) + (cb))))) + +(defun forge--ghub-massage-notification (data forge githost) + (let-alist data + (let* ((type (intern (downcase .subject.type))) + (type (if (eq type 'pullrequest) 'pullreq type))) + (and (memq type '(pullreq issue)) + (let* ((number (and (string-match "[0-9]*\\'" .subject.url) + (string-to-number (match-string 0 .subject.url)))) + (repo (forge-get-repository + (list githost + .repository.owner.login + .repository.name) + nil 'create)) + (repoid (oref repo id)) + (owner (oref repo owner)) + (name (oref repo name)) + (id (forge--object-id repoid (string-to-number .id))) + (alias (intern (concat "_" (string-replace "=" "_" id))))) + (list alias repo + `((,alias repository) + [(name ,name) + (owner ,owner)] + ,@(cddr + (caddr + (ghub--graphql-prepare-query + ghub-fetch-repository + (if (eq type 'issue) + `(repository issues (issue . ,number)) + `(repository pullRequest (pullRequest . ,number))) + )))) + (forge-notification + :id id + :thread-id .id + :repository repoid + :forge forge + :reason (intern (downcase .reason)) + :unread-p .unread + :last-read .last_read_at + :updated .updated_at + :title .subject.title + :type type + :topic number + :url .subject.url))))))) + +(cl-defmethod forge-topic-mark-read ((_ forge-github-repository) topic) + (when (oref topic unread-p) + (oset topic unread-p nil) + (when-let ((notif (forge-get-notification topic))) + (oset topic unread-p nil) + (forge--ghub-patch notif "/notifications/threads/:thread-id")))) + +;;;; Miscellaneous + +(cl-defmethod forge--add-user-repos + ((class (subclass forge-github-repository)) host user) + (forge--fetch-user-repos + class (forge--as-apihost host) user + (apply-partially #'forge--batch-add-callback (forge--as-githost host) user))) + +(cl-defmethod forge--add-organization-repos + ((class (subclass forge-github-repository)) host org) + (forge--fetch-organization-repos + class (forge--as-apihost host) org + (apply-partially #'forge--batch-add-callback (forge--as-githost host) org))) + +(cl-defmethod forge--fetch-user-repos + ((_ (subclass forge-github-repository)) host user callback) + (ghub--graphql-vacuum + '(query (user + [(login $login String!)] + (repositories + [(:edges t) + (ownerAffiliations . (OWNER))] + name))) + `((login . ,user)) + (lambda (d) + (funcall callback + (--map (alist-get 'name it) + (let-alist d .user.repositories)))) + nil :auth 'forge :host host)) + +(cl-defmethod forge--fetch-organization-repos + ((_ (subclass forge-github-repository)) host org callback) + (ghub--graphql-vacuum + '(query (organization + [(login $login String!)] + (repositories [(:edges t)] name))) + `((login . ,org)) + (lambda (d) + (funcall callback + (--map (alist-get 'name it) + (let-alist d .organization.repositories)))) + nil :auth 'forge :host host)) + +(defun forge--batch-add-callback (host owner names) + (let ((repos (cl-mapcan (lambda (name) + (let ((repo (forge-get-repository + (list host owner name) + nil 'create))) + (and (oref repo sparse-p) + (list repo)))) + names)) + cb) + (setq cb (lambda () + (when-let ((repo (pop repos))) + (message "Adding %s..." (oref repo name)) + (forge--pull repo nil cb)))) + (funcall cb))) + +;;; Mutations + +(cl-defmethod forge--create-pullreq-from-issue ((repo forge-github-repository) + (issue forge-issue) + source target) + (pcase-let* ((`(,base-remote . ,base-branch) + (magit-split-branch-name target)) + (`(,head-remote . ,head-branch) + (magit-split-branch-name source)) + (head-repo (forge-get-repository 'stub head-remote))) + (forge--ghub-post repo "/repos/:owner/:repo/pulls" + `((issue . ,(oref issue number)) + (base . ,base-branch) + (head . ,(if (equal head-remote base-remote) + head-branch + (concat (oref head-repo owner) ":" + head-branch))) + (maintainer_can_modify . t)) + :callback (lambda (&rest _) + (closql-delete issue) + (forge-pull)) + :errorback (lambda (&rest _) (forge-pull))))) + +(cl-defmethod forge--submit-create-pullreq ((_ forge-github-repository) repo) + (let-alist (forge--topic-parse-buffer) + (when (and .yaml (local-variable-p 'forge-buffer-draft-p)) + (user-error "Cannot use yaml frontmatter and set `%s' at the same time" + 'forge-buffer-draft-p)) + (pcase-let* ((`(,base-remote . ,base-branch) + (magit-split-branch-name forge--buffer-base-branch)) + (`(,head-remote . ,head-branch) + (magit-split-branch-name forge--buffer-head-branch)) + (head-repo (forge-get-repository 'stub head-remote)) + (url-mime-accept-string + ;; Support draft pull-requests. + "application/vnd.github.shadow-cat-preview+json")) + (forge--ghub-post repo "/repos/:owner/:repo/pulls" + `((title . , .title) + (body . , .body) + (base . ,base-branch) + (head . ,(if (equal head-remote base-remote) + head-branch + (concat (oref head-repo owner) ":" + head-branch))) + (draft . ,(if (local-variable-p 'forge-buffer-draft-p) + forge-buffer-draft-p + .draft)) + (maintainer_can_modify . t)) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))))) + +(cl-defmethod forge--submit-create-issue ((_ forge-github-repository) repo) + (let-alist (forge--topic-parse-buffer) + (forge--ghub-post repo "/repos/:owner/:repo/issues" + `((title . , .title) + (body . , .body) + ,@(and .labels (list (cons 'labels .labels))) + ,@(and .assignees (list (cons 'assignees .assignees)))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback)))) + +(cl-defmethod forge--submit-create-post ((_ forge-github-repository) topic) + (forge--ghub-post topic "/repos/:owner/:repo/issues/:number/comments" + `((body . ,(string-trim (buffer-string)))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))) + +(cl-defmethod forge--submit-edit-post ((_ forge-github-repository) post) + (forge--ghub-patch post + (cl-typecase post + (forge-pullreq "/repos/:owner/:repo/pulls/:number") + (forge-issue "/repos/:owner/:repo/issues/:number") + (forge-post "/repos/:owner/:repo/issues/comments/:number")) + (if (cl-typep post 'forge-topic) + (let-alist (forge--topic-parse-buffer) + `((title . , .title) + (body . , .body))) + `((body . ,(string-trim (buffer-string))))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))) + +(cl-defmethod forge--set-topic-title + ((_repo forge-github-repository) topic title) + (forge--ghub-patch topic + "/repos/:owner/:repo/issues/:number" + `((title . ,title)) + :callback (forge--set-field-callback))) + +(cl-defmethod forge--set-topic-state + ((_repo forge-github-repository) topic) + (forge--ghub-patch topic + "/repos/:owner/:repo/issues/:number" + `((state . ,(cl-ecase (oref topic state) + (closed "OPEN") + (open "CLOSED")))) + :callback (forge--set-field-callback))) + +(cl-defmethod forge--set-topic-draft + ((_repo forge-github-repository) topic value) + (let ((buffer (current-buffer))) + (ghub-graphql + `(mutation (,(if value + 'convertPullRequestToDraft + 'markPullRequestReadyForReview) + [(input $input ,(if value + 'ConvertPullRequestToDraftInput! + 'MarkPullRequestReadyForReviewInput!))] + (pullRequest isDraft))) + `((input (pullRequestId . ,(oref topic their-id)))) + :host (oref (forge-get-repository topic) apihost) + :auth 'forge + :callback (lambda (data &rest _) + (if (assq 'error data) + (ghub--graphql-pp-response data) + (oset topic draft-p value) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (magit-refresh-buffer)))))))) + +(cl-defmethod forge--set-topic-milestone + ((repo forge-github-repository) topic milestone) + (forge--ghub-patch topic + "/repos/:owner/:repo/issues/:number" + `((milestone + . ,(caar (forge-sql [:select [number] + :from milestone + :where (and (= repository $s1) + (= title $s2))] + (oref repo id) + milestone)))) + :callback (forge--set-field-callback))) + +(cl-defmethod forge--set-topic-labels + ((_repo forge-github-repository) topic labels) + (forge--ghub-put topic "/repos/:owner/:repo/issues/:number/labels" nil + :payload labels + :callback (forge--set-field-callback))) + +(cl-defmethod forge--set-topic-assignees + ((_repo forge-github-repository) topic assignees) + (let ((value (mapcar #'car (closql--iref topic 'assignees)))) + (when-let ((add (cl-set-difference assignees value :test #'equal))) + (forge--ghub-post topic "/repos/:owner/:repo/issues/:number/assignees" + `((assignees . ,add)))) + (when-let ((remove (cl-set-difference value assignees :test #'equal))) + (forge--ghub-delete topic "/repos/:owner/:repo/issues/:number/assignees" + `((assignees . ,remove))))) + (forge-pull)) + +(cl-defmethod forge--set-topic-review-requests + ((_repo forge-github-repository) topic reviewers) + (let ((value (mapcar #'car (closql--iref topic 'review-requests)))) + (when-let ((add (cl-set-difference reviewers value :test #'equal))) + (forge--ghub-post topic + "/repos/:owner/:repo/pulls/:number/requested_reviewers" + `((reviewers . ,add)))) + (when-let ((remove (cl-set-difference value reviewers :test #'equal))) + (forge--ghub-delete topic + "/repos/:owner/:repo/pulls/:number/requested_reviewers" + `((reviewers . ,remove))))) + (forge-pull)) + +(cl-defmethod forge--delete-comment + ((_repo forge-github-repository) post) + (forge--ghub-delete post "/repos/:owner/:repo/issues/comments/:number") + (closql-delete post) + (magit-refresh)) + +(cl-defmethod forge--topic-templates ((repo forge-github-repository) + (_ (subclass forge-issue))) + (and-let* ((files (magit-revision-files (oref repo default-branch)))) + (let ((case-fold-search t)) + (if-let ((file (--first (string-match-p "\ +\\`\\(\\|docs/\\|\\.github/\\)issue_template\\(\\.[a-zA-Z0-9]+\\)?\\'" it) + files))) + (list file) + (setq files + (--filter (string-match-p "\\`\\.github/ISSUE_TEMPLATE/[^/]*" it) + files)) + (if-let ((conf (cl-find-if + (lambda (f) + (equal (file-name-nondirectory f) "config.yml")) + files))) + (nconc (delete conf files) + (list conf)) + files))))) + +(cl-defmethod forge--topic-templates ((repo forge-github-repository) + (_ (subclass forge-pullreq))) + (and-let* ((files (magit-revision-files (oref repo default-branch)))) + (let ((case-fold-search t)) + (if-let ((file (--first (string-match-p "\ +\\`\\(\\|docs/\\|\\.github/\\)pull_request_template\\(\\.[a-zA-Z0-9]+\\)?\\'" it) + files))) + (list file) + ;; Unlike for issues, the web interface does not support + ;; multiple pull-request templates. The API does though, + ;; but due to this limitation I doubt many people use them, + ;; so Forge doesn't support them either. + )))) + +(cl-defmethod forge--set-default-branch ((repo forge-github-repository) + newname oldname) + (forge--ghub-post repo + (format "/repos/:owner/:name/branches/%s/rename" oldname) + `((new_name . ,newname))) + (message "Waiting 5 seconds for GitHub to complete rename...") + (sleep-for 5) + (message "Waiting 5 seconds for GitHub to complete rename...done") + (magit-call-git "fetch" "--prune" (oref repo remote)) + (magit--set-default-branch newname oldname)) + +(cl-defmethod forge--fork-repository ((repo forge-github-repository) fork) + (with-slots (owner name) repo + (forge--ghub-post repo + (format "/repos/%s/%s/forks" owner name) + (and (not (equal fork (ghub--username (ghub--host nil)))) + `((organization . ,fork)))) + (ghub-wait (format "/repos/%s/%s" fork name) nil :auth 'forge))) + +(cl-defmethod forge--merge-pullreq ((_repo forge-github-repository) + topic hash method) + (forge--ghub-put topic + "/repos/:owner/:repo/pulls/:number/merge" + `((merge_method . ,(symbol-name method)) + ,@(and hash `((sha . ,hash)))))) + +;;; Utilities + +(cl-defun forge--ghub-get (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host + callback errorback) + (declare (indent defun)) + (ghub-get (if obj (forge--format-resource obj resource) resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback :errorback errorback)) + +(cl-defun forge--ghub-put (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host + callback errorback) + (declare (indent defun)) + (ghub-put (if obj (forge--format-resource obj resource) resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback :errorback errorback)) + +(cl-defun forge--ghub-post (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (ghub-post (forge--format-resource obj resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback :errorback errorback)) + +(cl-defun forge--ghub-patch (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (ghub-patch (forge--format-resource obj resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback :errorback errorback)) + +(cl-defun forge--ghub-delete (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (ghub-delete (forge--format-resource obj resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback :errorback errorback)) + +;;; _ +(provide 'forge-github) +;;; forge-github.el ends here diff --git a/elpa/forge-20230711.1157/forge-gitlab.el b/elpa/forge-20230711.1157/forge-gitlab.el new file mode 100644 index 00000000..a318bbba --- /dev/null +++ b/elpa/forge-20230711.1157/forge-gitlab.el @@ -0,0 +1,672 @@ +;;; forge-gitlab.el --- Gitlab support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 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) until) + (let ((cb (let ((buf (and (derived-mode-p 'magit-mode) + (current-buffer))) + (dir default-directory) + (val nil)) + (lambda (cb &optional v) + (when v (if val (push v val) (setq val v))) + (let-alist val + (cond + ((not val) + (forge--fetch-repository repo cb)) + ((not (assq 'assignees val)) + (forge--fetch-assignees repo cb)) + ((not (assq 'forks val)) + (forge--fetch-forks repo cb)) + ((not (assq 'labels val)) + (forge--fetch-labels repo cb)) + ((and .issues_enabled + (not (assq 'issues val))) + (forge--fetch-issues repo cb until)) + ((and .merge_requests_enabled + (not (assq 'pullreqs val))) + (forge--fetch-pullreqs repo cb until)) + (t + (forge--msg repo t t "Pulling REPO") + (forge--msg repo t nil "Storing REPO") + (closql-with-transaction (forge-db) + (forge--update-repository repo val) + (forge--update-assignees repo .assignees) + (forge--update-labels repo .labels) + (dolist (v .issues) (forge--update-issue repo v)) + (dolist (v .pullreqs) (forge--update-pullreq repo v)) + (oset repo sparse-p nil)) + (forge--msg repo t t "Storing REPO") + (unless (oref repo selective-p) + (forge--git-fetch buf dir repo))))))))) + (funcall cb cb))) + +(cl-defmethod forge--fetch-repository ((repo forge-gitlab-repository) callback) + (forge--glab-get repo "/projects/:project" nil + :callback (lambda (value _headers _status _req) + (cond ((oref repo selective-p) + (setq value (append '((assignees) (forks) (labels) + (issues) (pullreqs)) + value))) + ((magit-get-boolean "forge.omitExpensive") + (setq value (append '((assignees) (forks) (labels)) + value)))) + (funcall callback callback value)))) + +(cl-defmethod forge--update-repository ((repo forge-gitlab-repository) data) + (let-alist data + (oset repo created .created_at) + (oset repo updated .last_activity_at) + (oset repo pushed nil) + (oset repo parent .forked_from_project.path_with_namespace) + (oset repo description .description) + (oset repo homepage nil) + (oset repo default-branch .default_branch) + (oset repo archived-p .archived) + (oset repo fork-p (and .forked_from_project.path_with_namespace t)) + (oset repo locked-p nil) + (oset repo mirror-p .mirror) + (oset repo private-p (equal .visibility "private")) + (oset repo issues-p .issues_enabled) + (oset repo wiki-p .wiki_enabled) + (oset repo stars .star_count) + (oset repo watchers .star_count))) + +(cl-defmethod forge--split-url-path + ((_class (subclass forge-gitlab-repository)) path) + (and (string-match "\\`\\(?:~?\\(.+\\)/\\)?\\([^/]+?\\)\\'" path) + (list (match-string 1 path) + (match-string 2 path)))) + +;;;; Issues + +(cl-defmethod forge--fetch-issues ((repo forge-gitlab-repository) callback until) + (let ((cb (let (val cur cnt pos) + (lambda (cb &optional v) + (cond + ((not pos) + (if (setq cur (setq val v)) + (progn + (setq pos 1) + (setq cnt (length val)) + (forge--msg nil nil nil "Pulling issue %s/%s" pos cnt) + (forge--fetch-issue-posts repo cur cb)) + (forge--msg repo t t "Pulling REPO issues") + (funcall callback callback (cons 'issues val)))) + (t + (if (setq cur (cdr cur)) + (progn + (cl-incf pos) + (forge--msg nil nil nil "Pulling issue %s/%s" pos cnt) + (forge--fetch-issue-posts repo cur cb)) + (forge--msg repo t t "Pulling REPO issues") + (funcall callback callback (cons 'issues val))))))))) + (forge--msg repo t nil "Pulling REPO issues") + (forge--glab-get repo "/projects/:project/issues" + `((per_page . 100) + (order_by . "updated_at") + ,@(and-let* ((after (forge--topics-until repo until 'issue))) + `((updated_after . ,after)))) + :unpaginate t + :callback (lambda (value _headers _status _req) + (funcall cb cb value))))) + +(cl-defmethod forge--fetch-issue-posts ((repo forge-gitlab-repository) cur cb) + (let-alist (car cur) + (forge--glab-get repo + (format "/projects/%s/issues/%s/notes" .project_id .iid) + '((per_page . 100)) + :unpaginate t + :callback (lambda (value _headers _status _req) + (setf (alist-get 'notes (car cur)) value) + (funcall cb cb))))) + +(cl-defmethod forge--update-issue ((repo forge-gitlab-repository) data) + (closql-with-transaction (forge-db) + (let-alist data + (let* ((issue-id (forge--object-id 'forge-issue repo .iid)) + (issue + (forge-issue + :id issue-id + :their-id .iid + :number .iid + :repository (oref repo id) + :state (pcase-exhaustive .state + ("closed" 'closed) + ("opened" 'open)) + :author .author.username + :title .title + :created .created_at + :updated .updated_at + ;; `.closed_at' may be nil even though the issues is + ;; closed. In such cases use 1, so that this slots + ;; at least can serve as a boolean. + :closed (or .closed_at (and (equal .state "closed") 1)) + :locked-p .discussion_locked + :milestone .milestone.iid + :body (forge--sanitize-string .description)))) + (closql-insert (forge-db) issue t) + (unless (magit-get-boolean "forge.omitExpensive") + (forge--set-id-slot repo issue 'assignees .assignees) + (forge--set-id-slot repo issue 'labels .labels)) + .body .id ; Silence Emacs 25 byte-compiler. + (dolist (c .notes) + (let-alist c + (let ((post + (forge-issue-post + :id (forge--object-id issue-id .id) + :issue issue-id + :number .id + :author .author.username + :created .created_at + :updated .updated_at + :body (forge--sanitize-string .body)))) + (closql-insert (forge-db) post t)))))))) + +;;;; Pullreqs + +(cl-defmethod forge--fetch-pullreqs ((repo forge-gitlab-repository) callback until) + (let ((cb (let (val cur cnt pos) + (lambda (cb &optional v) + (cond + ((not pos) + (if (setq cur (setq val v)) + (progn + (setq pos 1) + (setq cnt (length val)) + (forge--msg nil nil nil "Pulling pullreq %s/%s" pos cnt) + (forge--fetch-pullreq-posts repo cur cb)) + (forge--msg repo t t "Pulling REPO pullreqs") + (funcall callback callback (cons 'pullreqs val)))) + ((not (assq 'source_project (car cur))) + (forge--fetch-pullreq-source-repo repo cur cb)) + ((not (assq 'target_project (car cur))) + (forge--fetch-pullreq-target-repo repo cur cb)) + (t + (if (setq cur (cdr cur)) + (progn + (cl-incf pos) + (forge--msg nil nil nil "Pulling pullreq %s/%s" pos cnt) + (forge--fetch-pullreq-posts repo cur cb)) + (forge--msg repo t t "Pulling REPO pullreqs") + (funcall callback callback (cons 'pullreqs val))))))))) + (forge--msg repo t nil "Pulling REPO pullreqs") + (forge--glab-get repo "/projects/:project/merge_requests" + `((per_page . 100) + (order_by . "updated_at") + ,@(and-let* ((after (forge--topics-until repo until 'pullreq))) + `((updated_after . ,after)))) + :unpaginate t + :callback (lambda (value _headers _status _req) + (funcall cb cb value))))) + +(cl-defmethod forge--fetch-pullreq-posts + ((repo forge-gitlab-repository) cur cb) + (let-alist (car cur) + (forge--glab-get repo + (format "/projects/%s/merge_requests/%s/notes" .target_project_id .iid) + '((per_page . 100)) + :unpaginate t + :callback (lambda (value _headers _status _req) + (setf (alist-get 'notes (car cur)) value) + (funcall cb cb))))) + +(cl-defmethod forge--fetch-pullreq-source-repo + ((repo forge-gitlab-repository) cur cb) + ;; If the fork no longer exists, then `.source_project_id' is nil. + ;; This will lead to difficulties later on but there is nothing we + ;; can do about it. + (let-alist (car cur) + (if .source_project_id + (forge--glab-get repo (format "/projects/%s" .source_project_id) nil + :errorback (lambda (_err _headers _status _req) + (setf (alist-get 'source_project (car cur)) nil) + (funcall cb cb)) + :callback (lambda (value _headers _status _req) + (setf (alist-get 'source_project (car cur)) value) + (funcall cb cb))) + (setf (alist-get 'source_project (car cur)) nil) + (funcall cb cb)))) + +(cl-defmethod forge--fetch-pullreq-target-repo + ((repo forge-gitlab-repository) cur cb) + (let-alist (car cur) + (forge--glab-get repo (format "/projects/%s" .target_project_id) nil + :errorback (lambda (_err _headers _status _req) + (setf (alist-get 'target_project (car cur)) nil) + (funcall cb cb)) + :callback (lambda (value _headers _status _req) + (setf (alist-get 'target_project (car cur)) value) + (funcall cb cb))))) + +(cl-defmethod forge--update-pullreq ((repo forge-gitlab-repository) data) + (closql-with-transaction (forge-db) + (let-alist data + (let* ((pullreq-id (forge--object-id 'forge-pullreq repo .iid)) + (pullreq + (forge-pullreq + :id pullreq-id + :their-id .iid + :number .iid + :repository (oref repo id) + :state (pcase-exhaustive .state + ("merged" 'merged) + ("closed" 'closed) + ("opened" 'open)) + :author .author.username + :title .title + :created .created_at + :updated .updated_at + ;; `.merged_at' and `.closed_at' may both be nil even + ;; though the pullreq is merged or otherwise closed. + ;; In such cases use 1, so that these slots at least + ;; can serve as booleans. + :closed (or .closed_at + (and (member .state '("closed" "merged")) 1)) + :merged (or .merged_at + (and (equal .state "merged") 1)) + :draft-p .draft + :locked-p .discussion_locked + :editable-p .allow_maintainer_to_push + :cross-repo-p (not (equal .source_project_id + .target_project_id)) + :base-ref .target_branch + :base-rev .diff_refs.start_sha + :base-repo .target_project.path_with_namespace + :head-ref .source_branch + :head-rev .diff_refs.head_sha + :head-user .source_project.owner.username + :head-repo .source_project.path_with_namespace + :milestone .milestone.iid + :body (forge--sanitize-string .description)))) + (closql-insert (forge-db) pullreq t) + (unless (magit-get-boolean "forge.omitExpensive") + (forge--set-id-slot repo pullreq 'assignees .assignees) + (forge--set-id-slot repo pullreq 'review-requests .reviewers) + (forge--set-id-slot repo pullreq 'labels .labels)) + .body .id ; Silence Emacs 25 byte-compiler. + (dolist (c .notes) + (let-alist c + (let ((post + (forge-pullreq-post + :id (forge--object-id pullreq-id .id) + :pullreq pullreq-id + :number .id + :author .author.username + :created .created_at + :updated .updated_at + :body (forge--sanitize-string .body)))) + (closql-insert (forge-db) post t)))))))) + +;;;; Other + +;; The extend of the documentation for "GET /projects/:id/users" is +;; "Get the users list of a project." I don't know what that means, +;; but it stands to reason that this must at least overlap with the +;; set of users that can be assigned to topics. + +(cl-defmethod forge--fetch-assignees ((repo forge-gitlab-repository) callback) + (forge--glab-get repo "/projects/:project/users" + '((per_page . 100)) + :unpaginate t + :callback (lambda (value _headers _status _req) + (funcall callback callback (cons 'assignees value))))) + +(cl-defmethod forge--update-assignees ((repo forge-gitlab-repository) data) + (oset repo assignees + (with-slots (id) repo + (mapcar (lambda (row) + (let-alist row + ;; For other forges we don't need to store `id' + ;; but here we do because that's what has to be + ;; used when assigning issues. + (list (forge--object-id id .id) + .username + .name + .id))) + data)))) + +(cl-defmethod forge--fetch-forks ((repo forge-gitlab-repository) callback) + (forge--glab-get repo "/projects/:project/forks" + '((per_page . 100) + (simple . t)) + :unpaginate t + :callback (lambda (value _headers _status _req) + (funcall callback callback (cons 'forks value))))) + +(cl-defmethod forge--update-forks ((repo forge-gitlab-repository) data) + (oset repo forks + (with-slots (id) repo + (mapcar (lambda (row) + (let-alist row + (nconc (forge--repository-ids + (eieio-object-class repo) + (oref repo githost) + .namespace.path + .path) + (list .namespace.path + .path)))) + data)))) + +(cl-defmethod forge--fetch-labels ((repo forge-gitlab-repository) callback) + (forge--glab-get repo "/projects/:project/labels" + '((per_page . 100)) + :unpaginate t + :callback (lambda (value _headers _status _req) + (funcall callback callback (cons 'labels value))))) + +(cl-defmethod forge--update-labels ((repo forge-gitlab-repository) data) + (oset repo labels + (with-slots (id) repo + (mapcar (lambda (row) + (let-alist row + ;; We should use the label's `id' instead of its + ;; `name' but a topic's `labels' field is a list + ;; of names instead of a list of ids or an alist. + ;; As a result of this we cannot recognize when + ;; a label is renamed and a topic continues to be + ;; tagged with the old label name until it itself + ;; is modified somehow. Additionally it leads to + ;; name conflicts between group and project + ;; labels. See #160. + (list (forge--object-id id .name) + .name + (downcase .color) + .description))) + ;; For now simply remove one of the duplicates. + (cl-delete-duplicates data + :key (apply-partially #'alist-get 'name) + :test #'equal))))) + +;;;; Notifications + +;; The closest to notifications that Gitlab provides are "events" as +;; described at https://docs.gitlab.com/ee/api/events.html. This +;; allows us to see the last events that took place, but that is not +;; good enough because we are mostly interested in events we haven't +;; looked at yet. Gitlab doesn't make a distinction between unread +;; and read events, so this is rather useless and we don't use it for +;; the time being. + +;;; Mutations + +(cl-defmethod forge--submit-create-pullreq ((_ forge-gitlab-repository) base-repo) + (let-alist (forge--topic-parse-buffer) + (pcase-let* ((`(,base-remote . ,base-branch) + (magit-split-branch-name forge--buffer-base-branch)) + (`(,head-remote . ,head-branch) + (magit-split-branch-name forge--buffer-head-branch)) + (head-repo (forge-get-repository 'stub head-remote))) + (forge--glab-post head-repo "/projects/:project/merge_requests" + `((title . ,(if (if (local-variable-p 'forge-buffer-draft-p) + forge-buffer-draft-p + .draft) + (concat "Draft: " .title) + .title)) + (description . , .body) + ,@(and (not (equal head-remote base-remote)) + `((target_project_id . ,(oref base-repo forge-id)))) + (target_branch . ,base-branch) + (source_branch . ,head-branch) + (allow_collaboration . t)) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))))) + +(cl-defmethod forge--submit-create-issue ((_ forge-gitlab-repository) repo) + (let-alist (forge--topic-parse-buffer) + (forge--glab-post repo "/projects/:project/issues" + `((title . , .title) + (description . , .body)) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback)))) + +(cl-defmethod forge--submit-create-post ((_ forge-gitlab-repository) topic) + (forge--glab-post topic + (if (forge-issue-p topic) + "/projects/:project/issues/:number/notes" + "/projects/:project/merge_requests/:number/notes") + `((body . ,(string-trim (buffer-string)))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))) + +(cl-defmethod forge--submit-edit-post ((_ forge-gitlab-repository) post) + (forge--glab-put post + (cl-etypecase post + (forge-pullreq "/projects/:project/merge_requests/:number") + (forge-issue "/projects/:project/issues/:number") + (forge-issue-post "/projects/:project/issues/:topic/notes/:number") + (forge-pullreq-post "/projects/:project/merge_requests/:topic/notes/:number")) + (if (cl-typep post 'forge-topic) + (let-alist (forge--topic-parse-buffer) + ;; Keep Gitlab from claiming that the user + ;; changed the description when that isn't + ;; true. The same isn't necessary for the + ;; title; in that case Gitlab performs the + ;; necessary check itself. + `((title . , .title) + ,@(and (not (equal .body (oref post body))) + `((description . , .body))))) + `((body . ,(string-trim (buffer-string))))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))) + +(cl-defmethod forge--set-topic-field + ((_repo forge-gitlab-repository) topic field value) + (forge--glab-put topic + (cl-typecase topic + (forge-pullreq "/projects/:project/merge_requests/:number") + (forge-issue "/projects/:project/issues/:number")) + `((,field . ,value)) + :callback (forge--set-field-callback))) + +(cl-defmethod forge--set-topic-title + ((repo forge-gitlab-repository) topic title) + (forge--set-topic-field repo topic 'title title)) + +(cl-defmethod forge--set-topic-state + ((repo forge-gitlab-repository) topic) + (forge--set-topic-field repo topic 'state_event + (cl-ecase (oref topic state) + (closed "reopen") + (open "close")))) + +(cl-defmethod forge--set-topic-draft + ((repo forge-gitlab-repository) topic value) + (let ((buffer (current-buffer))) + (glab-graphql + `(mutation (mergeRequestSetDraft + [(input $input MergeRequestSetDraftInput!)] + (mergeRequest iid draft))) + `((input (projectPath . ,(format "%s/%s" + (oref repo owner) + (oref repo name))) + (iid . ,(number-to-string (oref topic number))) + (draft . ,value))) + :host (oref (forge-get-repository topic) apihost) + :auth 'forge + :callback (lambda (data &rest _) + (if (assq 'error data) + (ghub--graphql-pp-response data) + (oset topic draft-p value) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (magit-refresh-buffer)))))))) + +(cl-defmethod forge--set-topic-labels + ((repo forge-gitlab-repository) topic labels) + (forge--set-topic-field repo topic 'labels + (mapconcat #'identity labels ","))) + +(cl-defmethod forge--set-topic-assignees + ((repo forge-gitlab-repository) topic assignees) + (let ((users (mapcar #'cdr (oref repo assignees)))) + (cl-typecase topic + (forge-pullreq ; Can only be assigned to a single user. + (forge--set-topic-field repo topic 'assignee_id + (or (caddr (assoc (car assignees) users)) + 0))) + (forge-issue + (forge--set-topic-field repo topic 'assignee_ids + (or (--map (caddr (assoc it users)) assignees) + 0)))))) + +(cl-defmethod forge--set-topic-review-requests + ((repo forge-gitlab-repository) topic reviewers) + (let ((users (mapcar #'cdr (oref repo assignees)))) + (forge--set-topic-field repo topic 'reviewer_ids + (or (--map (caddr (assoc it users)) reviewers) + 0)))) + +(cl-defmethod forge--delete-comment + ((_repo forge-gitlab-repository) post) + (forge--glab-delete post + (cl-etypecase post + (forge-pullreq-post + "/projects/:project/merge_requests/:topic/notes/:number") + (forge-issue-post + "/projects/:project/issues/:topic/notes/:number"))) + (closql-delete post) + (magit-refresh)) + +(cl-defmethod forge--topic-templates ((repo forge-gitlab-repository) + (_ (subclass forge-issue))) + (--filter (string-match-p "\\`\\.gitlab/issue_templates/.+\\.md\\'" it) + (magit-revision-files (oref repo default-branch)))) + +(cl-defmethod forge--topic-templates ((repo forge-gitlab-repository) + (_ (subclass forge-pullreq))) + (--filter (string-match-p "\\`\\.gitlab/merge_request_templates/.+\\.md\\'" it) + (magit-revision-files (oref repo default-branch)))) + +(cl-defmethod forge--fork-repository ((repo forge-gitlab-repository) fork) + (with-slots (owner name) repo + (forge--glab-post repo (format "/projects/%s%%2F%s/fork" owner name) + (and (not (equal fork (ghub--username (ghub--host nil)))) + `((namespace . ,fork))) + :noerror t) + (ghub-wait (format "/projects/%s%%2F%s" fork name) + nil :auth 'forge :forge 'gitlab))) + +(cl-defmethod forge--merge-pullreq ((_repo forge-gitlab-repository) + topic hash method) + (forge--glab-put topic + "/projects/:project/merge_requests/:number/merge" + `((squash . ,(eq method 'squash)) + ,@(and hash `((sha . ,hash)))))) + +;;; Utilities + +(cl-defmethod forge--topic-type-prefix ((_repo forge-gitlab-repository) type) + (if (eq type 'pullreq) "!" "#")) + +(cl-defun forge--glab-get (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (glab-get (if obj (forge--format-resource obj resource) resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback + :errorback (or errorback (and callback t)))) + +(cl-defun forge--glab-put (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (glab-put (if obj (forge--format-resource obj resource) resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback + :errorback (or errorback (and callback t)))) + +(cl-defun forge--glab-post (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (glab-post (forge--format-resource obj resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback + :errorback (or errorback (and callback t)))) + +(cl-defun forge--glab-delete (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (glab-delete (forge--format-resource obj resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback + :errorback (or errorback (and callback t)))) + +;;; _ +(provide 'forge-gitlab) +;;; forge-gitlab.el ends here diff --git a/elpa/forge-20230711.1157/forge-gogs.el b/elpa/forge-20230711.1157/forge-gogs.el new file mode 100644 index 00000000..a13aa8ac --- /dev/null +++ b/elpa/forge-20230711.1157/forge-gogs.el @@ -0,0 +1,46 @@ +;;; forge-gogs.el --- Gogs support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 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-20230711.1157/forge-issue.el b/elpa/forge-20230711.1157/forge-issue.el new file mode 100644 index 00000000..1142e56d --- /dev/null +++ b/elpa/forge-20230711.1157/forge-issue.el @@ -0,0 +1,225 @@ +;;; forge-issue.el --- Issue support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 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) + (closed :initarg :closed) + (unread-p :initarg :unread-p :initform nil) + (locked-p :initarg :locked-p) + (milestone :initarg :milestone) + (body :initarg :body) + (assignees :closql-table (issue-assignee assignee)) + (project-cards) ; projectsCards + (edits) ; userContentEdits + (labels :closql-table (issue-label label)) + (participants) + (posts :closql-class forge-issue-post) + (reactions) + (timeline) + (marks :closql-table (issue-mark mark)) + (note :initarg :note :initform nil) + (their-id :initarg :their-id) + )) + +(defclass forge-issue-post (forge-post) + ((closql-table :initform 'issue-post) + (closql-primary-key :initform 'id) + (closql-order-by :initform [(asc number)]) + (closql-foreign-key :initform 'issue) + (closql-class-prefix :initform "forge-issue-") + (id :initarg :id) + (issue :initarg :issue) + (number :initarg :number) + (author :initarg :author) + (created :initarg :created) + (updated :initarg :updated) + (body :initarg :body) + (edits) + (reactions) + )) + +;;; Query + +(cl-defmethod forge-get-repository ((post forge-issue-post)) + (forge-get-repository (forge-get-issue post))) + +(cl-defmethod forge-get-topic ((post forge-issue-post)) + (forge-get-issue post)) + +(cl-defmethod forge-get-issue ((issue forge-issue)) + issue) + +(cl-defmethod forge-get-issue ((repo forge-repository) number) + (closql-get (forge-db) + (forge--object-id 'forge-issue repo number) + 'forge-issue)) + +(cl-defmethod forge-get-issue ((number integer)) + (and-let* ((repo (forge-get-repository t))) + (forge-get-issue repo number))) + +(cl-defmethod forge-get-issue ((id string)) + (closql-get (forge-db) id 'forge-issue)) + +(cl-defmethod forge-get-issue ((post forge-issue-post)) + (closql-get (forge-db) + (oref post issue) + 'forge-issue)) + +(cl-defmethod forge-ls-issues ((repo forge-repository) &optional type select) + (forge-ls-topics repo 'forge-issue type select)) + +;;; Utilities + +(defun forge-read-issue (prompt &optional type) + (when (eq type t) + (setq type (if current-prefix-arg nil 'open))) + (let* ((default (forge-current-issue)) + (repo (forge-get-repository (or default t))) + (choices (mapcar + (apply-partially #'forge--topic-format-choice repo) + (forge-ls-issues repo type [number title id class])))) + (cdr (assoc (magit-completing-read + prompt choices nil nil nil nil + (and default + (setq default (forge--topic-format-choice default)) + (member default choices) + (car default))) + choices)))) + +(cl-defmethod forge-get-url ((issue forge-issue)) + (forge--format issue 'issue-url-format)) + +(defun forge--issue-by-forge-short-link-at-point () + (forge--topic-by-forge-short-link-at-point '("#") #'forge-get-issue)) + +;;; Sections + +(defun forge-current-issue () + (or (forge-issue-at-point) + (and (derived-mode-p 'forge-topic-mode) + (forge-issue-p forge-buffer-topic) + forge-buffer-topic) + (and (derived-mode-p 'forge-topic-list-mode) + (let ((topic (forge-get-topic (tabulated-list-get-id)))) + (and (forge-issue-p topic) + topic))))) + +(defun forge-issue-at-point () + (or (magit-section-value-if 'issue) + (and-let* ((post (magit-section-value-if 'post))) + (cond ((forge-issue-p post) + post) + ((forge-issue-post-p post) + (forge-get-issue post)))) + (forge--issue-by-forge-short-link-at-point))) + +(defvar-keymap forge-issues-section-map + " " #'forge-browse-issues + " " #'forge-list-issues + "C-c C-n" #'forge-create-issue) + +(defvar-keymap forge-issue-section-map + " " #'forge-browse-issue + " " #'forge-visit-issue) + +(defun forge-insert-issues () + "Insert a list of mostly recent and/or open issues. +Also see option `forge-topic-list-limit'." + (when (and forge-display-in-status-buffer (forge-db t)) + (when-let ((repo (forge-get-repository nil))) + (when (and (not (oref repo sparse-p)) + (or (not (slot-boundp repo 'issues-p)) ; temporary KLUDGE + (oref repo issues-p))) + (forge-insert-topics "Issues" + (forge-ls-recent-topics repo 'issue) + (forge--topic-type-prefix repo 'issue)))))) + +(defun forge-insert-assigned-issues () + "Insert a list of open issues that are assigned to you." + (when forge-display-in-status-buffer + (when-let ((repo (forge-get-repository nil))) + (unless (oref repo sparse-p) + (forge-insert-topics "Assigned issues" + (forge--ls-assigned-issues repo) + (forge--topic-type-prefix repo 'issue)))))) + +(defun forge--ls-assigned-issues (repo) + (mapcar (lambda (row) + (closql--remake-instance 'forge-issue (forge-db) row)) + (forge-sql + [:select $i1 :from [issue issue_assignee assignee] + :where (and (= issue_assignee:issue issue:id) + (= issue_assignee:id assignee:id) + (= issue:repository $s2) + (= assignee:login $s3) + (isnull issue:closed)) + :order-by [(desc updated)]] + (vconcat (closql--table-columns (forge-db) 'issue t)) + (oref repo id) + (ghub--username repo)))) + +(defun forge-insert-authored-issues () + "Insert a list of open issues that are authored to you." + (when forge-display-in-status-buffer + (when-let ((repo (forge-get-repository nil))) + (unless (oref repo sparse-p) + (forge-insert-topics "Authored issues" + (forge--ls-authored-issues repo) + (forge--topic-type-prefix repo 'issue)))))) + +(defun forge--ls-authored-issues (repo) + (mapcar (lambda (row) + (closql--remake-instance 'forge-issue (forge-db) row)) + (forge-sql + [:select $i1 :from [issue] + :where (and (= issue:repository $s2) + (= issue:author $s3) + (isnull issue:closed)) + :order-by [(desc updated)]] + (vconcat (closql--table-columns (forge-db) 'issue t)) + (oref repo id) + (ghub--username repo)))) + +;;; _ +(provide 'forge-issue) +;;; forge-issue.el ends here diff --git a/elpa/forge-20230711.1157/forge-list.el b/elpa/forge-20230711.1157/forge-list.el new file mode 100644 index 00000000..edd4154f --- /dev/null +++ b/elpa/forge-20230711.1157/forge-list.el @@ -0,0 +1,465 @@ +;;; forge-list.el --- Tabulated-list interface -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 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) + +(defvar x-stretch-cursor) + +;;; Options + +(defcustom forge-topic-list-mode-hook '(hl-line-mode) + "Hook run after entering Forge-Topic-List mode." + :package-version '(forge . "0.1.0") + :group 'forge + :type 'hook + :options '(hl-line-mode)) + +(defvar forge-topic-list-columns + '(("#" 5 forge-topic-list-sort-by-number (:right-align t) number nil) + ("Title" 35 t nil title nil) + )) + +(defvar forge-global-topic-list-columns + '(("Owner" 15 t nil repository:owner nil) + ("Name" 20 t nil repository:name nil) + ("#" 5 forge-topic-list-sort-by-number (:right-align t) number nil) + ("Title" 35 t nil title nil) + )) + +(defvar forge-repository-list-columns + '(("Owner" 20 t nil owner nil) + ("Name" 20 t nil name nil) + ("N" 1 t nil sparse-p nil) + ("S" 1 t nil selective-p nil) + ("Worktree" 99 t nil worktree nil) + )) + +(defcustom forge-owned-accounts nil + "An alist of accounts that are owned by you. +This should include your username as well as any organization +that you own. Used by the commands `forge-list-owned-issues', +`forge-list-owned-pullreqs' and `forge-fork'. + +Each element has the form (ACCOUNT . PLIST). The following +properties are currently being used: + +`remote-name' The default name suggested by `forge-fork' for a + fork created within this account. If unspecified, then the + name of the account is used." + :package-version '(forge . "0.2.0") + :group 'forge + :type '(repeat (cons (string :tag "Account") plist))) + +(define-obsolete-variable-alias 'forge-owned-blacklist + 'forge-owned-ignored "Forge 3.0.0") + +(defcustom forge-owned-ignored nil + "A list of repositories that are ignored when listing those owned by you. +This is a list of package names. Used by the commands +`forge-list-owned-issues' and `forge-list-owned-pullreqs'." + :package-version '(forge . "0.2.0") + :group 'forge + :type '(repeat (string :tag "Name"))) + +;;; Variables + +(defvar-local forge--tabulated-list-columns nil) +(put 'forge--tabulated-list-columns 'permanent-local t) + +(defvar-local forge--tabulated-list-query nil) +(put 'forge--tabulated-list-query 'permanent-local t) + +;;; Modes +;;;; Topics + +(defvar-keymap forge-topic-list-mode-map + :doc "Local keymap for Forge-Topic-List mode buffers." + :parent tabulated-list-mode-map + "RET" #'forge-visit-topic + "" #'forge-visit-topic + "o" #'forge-browse-topic + "'" #'forge-dispatch + "?" #'magit-dispatch) + +(define-derived-mode forge-topic-list-mode tabulated-list-mode + "Issues" + "Major mode for browsing a list of topics." + (setq-local x-stretch-cursor nil) + (setq tabulated-list-padding 0) + (setq tabulated-list-sort-key (cons "#" nil))) + +(define-derived-mode forge-issue-list-mode forge-topic-list-mode + "Issues" + "Major mode for browsing a list of issues.") + +(define-derived-mode forge-pullreq-list-mode forge-topic-list-mode + "Pull-Requests" + "Major mode for browsing a list of pull-requests.") + +(defun forge-topic-list-setup (mode id buffer-name columns fn) + (declare (indent 4)) + (let* ((repo (forge-get-repository (list :id id))) + (topdir (magit-toplevel))) + (with-current-buffer + (get-buffer-create + (or buffer-name + (format "*%s: %s/%s*" + (substring (symbol-name mode) 0 -5) + (oref repo owner) + (oref repo name)))) + (setq forge--tabulated-list-columns (or columns forge-topic-list-columns)) + (setq forge--tabulated-list-query fn) + (setq forge-buffer-repository repo) + (when topdir + (setq default-directory topdir)) + (cl-letf (((symbol-function #'tabulated-list-revert) #'ignore)) ; see #229 + (funcall mode)) + (forge-topic-list-refresh) + (add-hook 'tabulated-list-revert-hook + #'forge-topic-list-refresh nil t) + (tabulated-list-init-header) + (tabulated-list-print) + (switch-to-buffer (current-buffer))))) + +(defun forge-topic-list-refresh () + (setq tabulated-list-format + (vconcat (--map `(,@(-take 3 it) + ,@(-flatten (nth 3 it))) + forge--tabulated-list-columns))) + (tabulated-list-init-header) + (setq tabulated-list-entries + (mapcar #'forge--tablist-format-entry + (funcall forge--tabulated-list-query)))) + +;;;; Repository + +(defvar-keymap forge-repository-list-mode-map + :doc "Local keymap for Forge-Repository-List mode buffers." + :parent tabulated-list-mode-map + "RET" #'forge-visit-repository + "" #'forge-visit-repository + "o" #'forge-browse-repository + "'" #'forge-dispatch + "?" #'magit-dispatch) + +(define-derived-mode forge-repository-list-mode tabulated-list-mode + "Repositories" + "Major mode for browsing a list of repositories." + (setq-local x-stretch-cursor nil) + (setq forge--tabulated-list-columns forge-repository-list-columns) + (setq tabulated-list-padding 0) + (setq tabulated-list-sort-key (cons "Owner" nil)) + (setq tabulated-list-format + (vconcat (--map `(,@(-take 3 it) + ,@(-flatten (nth 3 it))) + forge-repository-list-columns))) + (tabulated-list-init-header)) + +(defun forge-repository-list-setup (fn buf) + (with-current-buffer (get-buffer-create buf) + (cl-letf (((symbol-function #'tabulated-list-revert) #'ignore)) ; see #229 + (forge-repository-list-mode)) + (funcall fn) + (add-hook 'tabulated-list-revert-hook fn nil t) + (tabulated-list-print) + (switch-to-buffer (current-buffer)))) + +(defun forge-repository-list-refresh () + (setq tabulated-list-entries + (mapcar #'forge--tablist-format-entry + (forge-sql [:select $i1 :from repository + :order-by [(asc owner) (asc name)]] + (forge--tablist-columns-vector))))) + +(defun forge-repository-list-owned-refresh () + (setq tabulated-list-entries + (mapcar #'forge--tablist-format-entry + (forge-sql [:select $i1 :from repository + :where (and (in owner $v2) + (not (in name $v3))) + :order-by [(asc owner) (asc name)]] + (forge--tablist-columns-vector) + (vconcat (mapcar #'car forge-owned-accounts)) + (vconcat forge-owned-ignored))))) + +;;; Commands +;;;; Topic + +;;;###autoload +(defun forge-list-topics (id) + "List topics of the current repository in a separate buffer." + (interactive (list (oref (forge-get-repository t) id))) + (forge-topic-list-setup #'forge-topic-list-mode id nil nil + (lambda () + (forge-sql [:select $i1 :from issue :where (= repository $s2) :union + :select $i1 :from pullreq :where (= repository $s2)] + (forge--tablist-columns-vector) + id)))) + +;;;; Issue + +;;;###autoload +(defun forge-list-issues (id) + "List issues of the current repository in a separate buffer." + (interactive (list (oref (forge-get-repository t) id))) + (forge-topic-list-setup #'forge-issue-list-mode id nil nil + (lambda () + (forge-sql [:select $i1 :from issue :where (= repository $s2)] + (forge--tablist-columns-vector) + id)))) + +;;;###autoload +(defun forge-list-labeled-issues (id label) + "List issues of the current repository that have LABEL. +List them in a separate buffer." + (interactive (list (oref (forge-get-repository t) id) + (magit-completing-read + "Label" + (mapcar #'cadr (oref (forge-get-repository t) labels)) + nil t))) + (forge-topic-list-setup #'forge-issue-list-mode id nil nil + (lambda () + (forge-sql [:select $i1 :from [issue issue_label label] + :where (and (= issue_label:issue issue:id) + (= issue_label:id label:id) + (= issue:repository $s2) + (= label:name $s3) + (isnull issue:closed)) + :order-by [(desc updated)]] + (forge--tablist-columns-vector 'issue) + id label)))) + +;;;###autoload +(defun forge-list-assigned-issues (id) + "List issues of the current repository that are assigned to you. +List them in a separate buffer." + (interactive (list (oref (forge-get-repository t) id))) + (forge-topic-list-setup #'forge-issue-list-mode id nil nil + (lambda () + (forge-sql [:select $i1 :from [issue issue_assignee assignee] + :where (and (= issue_assignee:issue issue:id) + (= issue_assignee:id assignee:id) + (= issue:repository $s2) + (= assignee:login $s3) + (isnull issue:closed)) + :order-by [(desc updated)]] + (forge--tablist-columns-vector 'issue) + id (ghub--username (forge-get-repository (list :id id))))))) + +;;;###autoload +(defun forge-list-owned-issues () + "List open issues from all your Github repositories. +Options `forge-owned-accounts' and `forge-owned-ignored' +controls which repositories are considered to be owned by you. +Only Github is supported for now." + (interactive) + (forge-topic-list-setup #'forge-issue-list-mode nil "My issues" + forge-global-topic-list-columns + (lambda () + (forge-sql [:select $i1 :from [issue repository] + :where (and (= issue:repository repository:id) + (in repository:owner $v2) + (not (in repository:name $v3)) + (isnull issue:closed)) + :order-by [(asc repository:owner) + (asc repository:name) + (desc issue:number)]] + (forge--tablist-columns-vector 'issue) + (vconcat (mapcar #'car forge-owned-accounts)) + (vconcat forge-owned-ignored))))) + +;;;; Pullreq + +;;;###autoload +(defun forge-list-pullreqs (id) + "List pull-requests of the current repository in a separate buffer." + (interactive (list (oref (forge-get-repository t) id))) + (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil + (lambda () + (forge-sql [:select $i1 :from pullreq :where (= repository $s2)] + (forge--tablist-columns-vector) + id)))) + +;;;###autoload +(defun forge-list-labeled-pullreqs (id label) + "List pull-requests of the current repository that have LABEL. +List them in a separate buffer." + (interactive (list (oref (forge-get-repository t) id) + (magit-completing-read + "Label" + (mapcar #'cadr (oref (forge-get-repository t) labels)) + nil t))) + (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil + (lambda () + (forge-sql [:select $i1 :from [pullreq pullreq_label label] + :where (and (= pullreq_label:pullreq pullreq:id) + (= pullreq_label:id label:id) + (= pullreq:repository $s2) + (= label:name $s3) + (isnull pullreq:closed)) + :order-by [(desc updated)]] + (forge--tablist-columns-vector 'pullreq) + id label)))) + +;;;###autoload +(defun forge-list-assigned-pullreqs (id) + "List pull-requests of the current repository that are assigned to you. +List them in a separate buffer." + (interactive (list (oref (forge-get-repository t) id))) + (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil + (lambda () + (forge-sql [:select $i1 :from [pullreq pullreq_assignee assignee] + :where (and (= pullreq_assignee:pullreq pullreq:id) + (= pullreq_assignee:id assignee:id) + (= pullreq:repository $s2) + (= assignee:login $s3) + (isnull pullreq:closed)) + :order-by [(desc updated)]] + (forge--tablist-columns-vector 'pullreq) + id (ghub--username (forge-get-repository (list :id id))))))) + +;;;###autoload +(defun forge-list-requested-reviews (id) + "List pull-requests of the current repository that are awaiting your review. +List them in a separate buffer." + (interactive (list (oref (forge-get-repository t) id))) + (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil + (lambda () + (forge-sql [:select $i1 :from [pullreq pullreq_review_request assignee] + :where (and (= pullreq_review_request:pullreq pullreq:id) + (= pullreq_review_request:id assignee:id) + (= pullreq:repository $s2) + (= assignee:login $s3) + (isnull pullreq:closed)) + :order-by [(desc updated)]] + (forge--tablist-columns-vector 'pullreq) + id (ghub--username (forge-get-repository (list :id id))))))) + +;;;###autoload +(defun forge-list-owned-pullreqs () + "List open pull-requests from all your Github repositories. +Options `forge-owned-accounts' and `forge-owned-ignored' +controls which repositories are considered to be owned by you. +Only Github is supported for now." + (interactive) + (forge-topic-list-setup #'forge-pullreq-list-mode nil "My pullreqs" + forge-global-topic-list-columns + (lambda () + (forge-sql [:select $i1 :from [pullreq repository] + :where (and (= pullreq:repository repository:id) + (in repository:owner $v2) + (not (in repository:name $v3)) + (isnull pullreq:closed)) + :order-by [(asc repository:owner) + (asc repository:name) + (desc pullreq:number)]] + (forge--tablist-columns-vector 'pullreq) + (vconcat (mapcar #'car forge-owned-accounts)) + (vconcat forge-owned-ignored))))) + +;;;###autoload +(defun forge-list-authored-pullreqs (id) + "List open pull-requests of the current repository that are authored by you. +List them in a separate buffer." + (interactive (list (oref (forge-get-repository t) id))) + (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil + (lambda () + (forge-sql [:select $i1 :from [pullreq] + :where (and (= pullreq:repository $s2) + (= pullreq:author $s3) + (isnull pullreq:closed)) + :order-by [(desc updated)]] + (forge--tablist-columns-vector 'pullreq) + id (ghub--username (forge-get-repository (list :id id))))))) + +;;;###autoload +(defun forge-list-authored-issues (id) + "List open issues from the current repository that are authored by you. +List them in a separate buffer." + (interactive (list (oref (forge-get-repository t) id))) + (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil + (lambda () + (forge-sql [:select $i1 :from [issue] + :where (and (= issue:repository $s2) + (= issue:author $s3) + (isnull issue:closed)) + :order-by [(desc updated)]] + (forge--tablist-columns-vector 'issue) + id (ghub--username (forge-get-repository (list :id id))))))) + +;;;; Repository + +;;;###autoload +(defun forge-list-repositories () + "List known repositories in a separate buffer. +Here \"known\" means that an entry exists in the local database." + (interactive) + (forge-repository-list-setup #'forge-repository-list-refresh + "*Forge Repositories*")) + +;;;###autoload +(defun forge-list-owned-repositories () + "List your own known repositories in a separate buffer. +Here \"known\" means that an entry exists in the local database +and options `forge-owned-accounts' and `forge-owned-ignored' +controls which repositories are considered to be owned by you. +Only Github is supported for now." + (interactive) + (forge-repository-list-setup #'forge-repository-list-owned-refresh + "*Forge Owned Repositories*")) + +;;; Internal + +(defun forge-topic-list-sort-by-number (a b) + "Sort the `tabulated-list-entries' by topic number. +This assumes that `number' is the first column, otherwise +it silently fails." + (ignore-errors + (> (read (aref (cadr a) 0)) + (read (aref (cadr b) 0))))) + +(defun forge--tablist-columns-vector (&optional table) + (let ((columns (cons 'id (--map (nth 4 it) forge--tabulated-list-columns)))) + (vconcat (if table + (let ((table (symbol-name table))) + (--map (let ((col (symbol-name it))) + (if (string-search ":" col) + it + (intern (concat table ":" col)))) + columns)) + columns)))) + +(defun forge--tablist-format-entry (row) + (list (car row) + (vconcat + (cl-mapcar (lambda (val col) + (if-let ((pp (nth 5 col))) + (funcall pp val) + (if val (format "%s" val) ""))) + (cdr row) + forge--tabulated-list-columns)))) + +;;; _ +(provide 'forge-list) +;;; forge-list.el ends here diff --git a/elpa/forge-20230711.1157/forge-notify.el b/elpa/forge-20230711.1157/forge-notify.el new file mode 100644 index 00000000..471deed7 --- /dev/null +++ b/elpa/forge-20230711.1157/forge-notify.el @@ -0,0 +1,151 @@ +;;; forge-notify.el --- Notify support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 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) + +;;; Class + +(defclass forge-notification (forge-object) + ((closql-class-prefix :initform "forge-") + (closql-table :initform 'notification) + (closql-primary-key :initform 'id) + (closql-order-by :initform [(desc id)]) + (id :initarg :id) + (thread-id :initarg :thread-id) + (repository :initarg :repository) + (forge :initarg :forge) + (reason :initarg :reason) + (unread-p :initarg :unread-p) + (last-read :initarg :last-read) + (updated :initarg :updated) + (title :initarg :title) + (type :initarg :type) + (topic :initarg :topic) + (url :initarg :url))) + +;;; Core + +(cl-defmethod forge-get-repository ((notify forge-notification)) + "Return the object for the repository that NOTIFY belongs to." + (and-let* ((id (oref notify repository))) + (closql-get (forge-db) id 'forge-repository))) + +(cl-defmethod forge-get-notification ((topic forge-topic)) + (and-let* ((row (car (forge-sql [:select * :from notification + :where (and (= repository $s1) + (= topic $s2))] + (oref topic repository) + (oref topic number))))) + (closql--remake-instance 'forge-notification (forge-db) row))) + +;;; Utilities + +(cl-defmethod forge-get-url ((notify forge-notification)) + (oref notify url)) + +;;; Mode + +(defvar-keymap forge-notifications-mode-map + :doc "Keymap for `forge-notifications-mode'." + :parent magit-mode-map) + +(define-derived-mode forge-notifications-mode magit-mode "Forge Notifications" + "Mode for looking at forge notifications." + (hack-dir-local-variables-non-file-buffer)) + +(defun forge-notifications-setup-buffer () + ;; There should only ever be one such buffer. + (cl-letf (((symbol-function 'magit-get-mode-buffer) + (lambda (&rest _) + (get-buffer-create "*forge-notifications*")))) + (magit-setup-buffer #'forge-notifications-mode))) + +(defun forge-notifications-refresh-buffer () + (forge-insert-notifications)) + +;;; Utilities + +(defun forge--list-notifications-all () + (closql-query (forge-db) nil nil 'forge-notification)) + +(defun forge--list-notifications-unread () + (mapcar (lambda (row) + (closql--remake-instance 'forge-notification (forge-db) row)) + (forge-sql [:select * :from notification + :where (notnull unread-p) + :order-by [(desc id)]]))) + +;;; Sections + +;; The double-prefix is necessary due to a limitation of magit-insert-section. +(defvar-keymap forge-forge-repo-section-map + " " #'forge-browse-repository + " " #'forge-visit-repository) + +(defun forge-insert-notifications () + (when-let ((ns (forge--list-notifications-all))) + (magit-insert-section (notifications) + (magit-insert-heading "Notifications:") + (pcase-dolist (`(,_ . ,ns) (--group-by (oref it repository) ns)) + (let ((repo (forge-get-repository (car ns)))) + (magit-insert-section (forge-repo repo t) + (magit-insert-heading + (concat (propertize (format "%s/%s" + (oref repo owner) + (oref repo name)) + 'font-lock-face 'bold) + (format " (%s)" (length ns)))) + (magit-insert-section-body + (dolist (notify ns) + (with-slots (type topic title url unread-p) notify + (pcase type + ('issue + (forge-insert-topic (forge-get-issue repo topic))) + ('pullreq + (forge-insert-topic (forge-get-pullreq repo topic))) + ('commit + (magit-insert-section (ncommit nil) ; !commit + (string-match "[^/]*\\'" url) + (insert + (format "%s %s\n" + (propertize (substring (match-string 0 url) + 0 (magit-abbrev-length)) + 'font-lock-face 'magit-hash) + (magit-log-propertize-keywords + nil (propertize title 'font-lock-face + (if unread-p + 'forge-topic-unread + 'forge-topic-open))))))) + (_ + ;; The documentation does not mention what "types" + ;; exist. Make it obvious that this is something + ;; we do not know how to handle properly yet. + (magit-insert-section (notification notify) + (insert (propertize (format "(%s) %s\n" type title) + 'font-lock-face 'error))))))) + (insert ?\n)))))))) + +;;; _ +(provide 'forge-notify) +;;; forge-notify.el ends here diff --git a/elpa/forge-20230711.1157/forge-pkg.el b/elpa/forge-20230711.1157/forge-pkg.el new file mode 100644 index 00000000..4324c385 --- /dev/null +++ b/elpa/forge-20230711.1157/forge-pkg.el @@ -0,0 +1,22 @@ +(define-package "forge" "20230711.1157" "Access Git forges from Magit." + '((emacs "25.1") + (compat "29.1.4.1") + (closql "20230407") + (dash "2.19.1") + (emacsql "20230409") + (ghub "20220621") + (let-alist "1.0.6") + (magit "20230319") + (markdown-mode "2.4") + (transient "0.4.0") + (yaml "0.5.2")) + :commit "32cbf6646132a982219bd7bca9091a25d4b97963" :authors + '(("Jonas Bernoulli" . "jonas@bernoul.li")) + :maintainer + '("Jonas Bernoulli" . "jonas@bernoul.li") + :keywords + '("git" "tools" "vc") + :url "https://github.com/magit/forge") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/forge-20230711.1157/forge-post.el b/elpa/forge-20230711.1157/forge-post.el new file mode 100644 index 00000000..4e76e6e1 --- /dev/null +++ b/elpa/forge-20230711.1157/forge-post.el @@ -0,0 +1,286 @@ +;;; forge-post.el --- Post support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 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 + +(cl-defmethod forge-get-parent ((post forge-post)) + (forge-get-topic post)) + +(cl-defmethod forge-get-repository ((post forge-post)) + (forge-get-repository (forge-get-topic post))) + +;;; Utilities + +(cl-defmethod forge-get-url ((post forge-post)) + (forge--format post (let ((topic (forge-get-parent post))) + (cond ((forge--childp topic 'forge-issue) + 'issue-post-url-format) + ((forge--childp topic 'forge-pullreq) + 'pullreq-post-url-format))))) + +(cl-defmethod forge-browse :after ((post forge-post)) + (oset (forge-get-topic post) unread-p nil)) + +;;; Sections + +(defun forge-post-at-point () + (magit-section-value-if '(issue pullreq post))) + +(defun forge-comment-at-point () + (and (magit-section-value-if '(post)) + (let ((post (oref (magit-current-section) value))) + (and (or (forge-pullreq-post-p post) + (forge-issue-post-p post)) + post)))) + +(defun forge-topic-at-point () + (or (magit-section-value-if '(issue pullreq)) + (and-let* ((branch (magit-branch-at-point)) + (n (magit-get "branch" branch "pullRequest"))) + (forge-get-pullreq (string-to-number n))) + (and-let* ((rev (magit-commit-at-point))) + (forge--pullreq-from-rev rev)) + (forge--issue-by-forge-short-link-at-point) + (forge--pullreq-by-forge-short-link-at-point))) + +(defun forge-current-topic () + (or (forge-topic-at-point) + (and (derived-mode-p 'forge-topic-mode) + forge-buffer-topic) + (and (derived-mode-p 'forge-topic-list-mode) + (forge-get-topic (tabulated-list-get-id))))) + +(defun forge--pullreq-from-rev (rev) + (and-let* ((repo (forge-get-repository nil)) + (refspec (oref repo pullreq-refspec)) + (name (magit-rev-name rev (cadr (split-string refspec ":"))))) + (save-match-data + (and (string-match "\\([0-9]*\\)\\([~^][0-9]*\\)?\\'" name) + (forge-get-pullreq (string-to-number (match-string 0 name))))))) + +;;; Utilities + +(cl-defmethod forge--format ((post forge-post) slot &optional spec) + (forge--format (forge-get-topic post) slot + `(,@spec (?I . ,(oref post number))))) + +;;; Mode + +(defvar-keymap forge-post-mode-map + "C-c C-e" #'forge-post-dispatch + "C-c C-c" #'forge-post-submit + " " #'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 t) + (if source 'forge-pullreq 'forge-issue)) + (cond + (.url + (browse-url .url) + (forge-post-cancel) + (setq buf nil) + (message "Using browser to visit %s instead of opening an issue" + .url)) + (.name + ;; A Github issue with yaml frontmatter. + (save-excursion (insert .text)) + (unless (re-search-forward "^title: " nil t) + (when (re-search-forward "^---" nil t 2) + (beginning-of-line) + (insert "title: \n") + (backward-char)))) + (t + (insert "# ") + (let ((single + (and source + (= (car (magit-rev-diff-count source target)) 1)))) + (save-excursion + (when single + ;; A pull-request. + (magit-rev-insert-format "%B" source)) + (when .text + (if single + (insert "-------\n") + (insert "\n")) + (insert "\n" .text))))))))) + buf))) + +(defun forge--display-post-buffer (buf) + (magit-display-buffer buf #'display-buffer)) + +(defun forge-post-cancel () + "Cancel the post that is being edited in the current buffer." + (interactive) + (save-buffer) + (if-let ((fn forge--cancel-post-function)) + (funcall fn forge--buffer-post-object) + (magit-mode-bury-buffer 'kill))) + +(defun forge-post-submit () + "Submit the post that is being edited in the current buffer." + (interactive) + (save-buffer) + (if-let ((fn forge--submit-post-function)) + (funcall fn + (forge-get-repository forge--buffer-post-object) + forge--buffer-post-object) + (error "forge--submit-post-function is nil"))) + +(defun forge--post-submit-callback () + (let* ((file buffer-file-name) + (editbuf (current-buffer)) + (prevbuf forge--pre-post-buffer) + (topic (ignore-errors (forge-get-topic forge--buffer-post-object))) + (repo (forge-get-repository topic))) + (lambda (value headers status req) + (run-hook-with-args 'forge-post-submit-callback-hook + value headers status req) + (delete-file file t) + (let ((dir (file-name-directory file))) + (unless (cddr (directory-files dir nil nil t)) + (delete-directory dir nil t))) + (when (buffer-live-p editbuf) + (with-current-buffer editbuf + (magit-mode-bury-buffer 'kill))) + (with-current-buffer + (if (buffer-live-p prevbuf) prevbuf (current-buffer)) + (if (and topic + (forge--childp repo 'forge-github-repository) + (or (and (fboundp 'forge-pullreq-p) + (forge-pullreq-p topic)) + (oref repo selective-p))) + (forge--pull-topic repo topic) + (forge-pull)))))) + +(defun forge--post-submit-errorback () + (lambda (error &rest _) + (error "Failed to submit post: %S" error))) + +(transient-define-prefix forge-post-dispatch () + "Dispatch a post creation command." + ["Variables" + ("d" "Create draft" forge-post-toggle-draft)] + ["Act" + ("C-c" "Submit" forge-post-submit) + ("C-k" "Cancel" forge-post-cancel)]) + +(transient-define-infix forge-post-toggle-draft () + "Toggle whether the pull-request being created is a draft." + :class 'transient-lisp-variable + :variable 'forge-buffer-draft-p + :reader (lambda (&rest _) (not forge-buffer-draft-p)) + :if (lambda () (equal (file-name-nondirectory buffer-file-name) "new-pullreq"))) + +;;; Notes + +(defclass forge-note (forge-post) ()) + +(defvar-keymap forge-note-section-map + " " #'forge-edit-topic-note) + +(defun forge--save-note (_repo topic) + (let ((value (string-trim (buffer-substring-no-properties + (point-min) + (point-max))))) + (oset topic note (if (equal value "") nil value))) + (delete-file buffer-file-name t) + (let ((dir (file-name-directory buffer-file-name))) + (unless (cddr (directory-files dir nil nil t)) + (delete-directory dir))) + (let ((prevbuf forge--pre-post-buffer)) + (magit-mode-bury-buffer 'kill) + (when (buffer-live-p prevbuf) + (magit-refresh)))) + +;;; _ +(provide 'forge-post) +;;; forge-post.el ends here diff --git a/elpa/forge-20230711.1157/forge-pullreq.el b/elpa/forge-20230711.1157/forge-pullreq.el new file mode 100644 index 00000000..7231a5b1 --- /dev/null +++ b/elpa/forge-20230711.1157/forge-pullreq.el @@ -0,0 +1,330 @@ +;;; forge-pullreq.el --- Pullreq support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 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) + (closed :initarg :closed) + (merged :initarg :merged) + (unread-p :initarg :unread-p :initform nil) + (locked-p :initarg :locked-p) + (editable-p :initarg :editable-p) + (cross-repo-p :initarg :cross-repo-p) + (base-ref :initarg :base-ref) + (base-repo :initarg :base-repo) + (head-ref :initarg :head-ref) + (head-user :initarg :head-user) + (head-repo :initarg :head-repo) + (milestone :initarg :milestone) + (body :initarg :body) + (assignees :closql-table (pullreq-assignee assignee)) + (project-cards) ; projectsCards + (commits) + (edits) ; userContentEdits + (labels :closql-table (pullreq-label label)) + (participants) + (posts :closql-class forge-pullreq-post) + (reactions) + (review-requests :closql-table (pullreq-review-request assignee)) + (reviews) + (timeline) + (marks :closql-table (pullreq-mark mark)) + (note :initarg :note :initform nil) + (base-rev :initarg :base-rev) + (head-rev :initarg :head-rev) + (draft-p :initarg :draft-p) + (their-id :initarg :their-id) + )) + +(defclass forge-pullreq-post (forge-post) + ((closql-table :initform 'pullreq-post) + (closql-primary-key :initform 'id) + (closql-order-by :initform [(asc number)]) + (closql-foreign-key :initform 'pullreq) + (closql-class-prefix :initform "forge-pullreq-") + (id :initarg :id) + (pullreq :initarg :pullreq) + (number :initarg :number) + (author :initarg :author) + (created :initarg :created) + (updated :initarg :updated) + (body :initarg :body) + (edits) + (reactions) + )) + +;;; Query + +(cl-defmethod forge-get-repository ((post forge-pullreq-post)) + (forge-get-repository (forge-get-pullreq post))) + +(cl-defmethod forge-get-topic ((post forge-pullreq-post)) + (forge-get-pullreq post)) + +(cl-defmethod forge-get-pullreq ((pullreq forge-pullreq)) + pullreq) + +(cl-defmethod forge-get-pullreq ((repo forge-repository) number) + (closql-get (forge-db) + (forge--object-id 'forge-pullreq repo number) + 'forge-pullreq)) + +(cl-defmethod forge-get-pullreq ((number integer)) + (and-let* ((repo (forge-get-repository t))) + (forge-get-pullreq repo number))) + +(cl-defmethod forge-get-pullreq ((id string)) + (closql-get (forge-db) id 'forge-pullreq)) + +(cl-defmethod forge-get-pullreq ((post forge-pullreq-post)) + (closql-get (forge-db) + (oref post pullreq) + 'forge-pullreq)) + +(cl-defmethod forge-ls-pullreqs ((repo forge-repository) &optional type select) + (forge-ls-topics repo 'forge-pullreq type select)) + +;;; Utilities + +(defun forge-read-pullreq (prompt &optional type) + (when (eq type t) + (setq type (if current-prefix-arg nil 'open))) + (let* ((default (forge-current-pullreq)) + (repo (forge-get-repository (or default t))) + (choices (mapcar + (apply-partially #'forge--topic-format-choice repo) + (forge-ls-pullreqs repo type [number title id class])))) + (cdr (assoc (magit-completing-read + prompt choices nil nil nil nil + (and default + (setq default (forge--topic-format-choice default)) + (member default choices) + (car default))) + choices)))) + +(defun forge--pullreq-branch-internal (pullreq) + (let ((branch (oref pullreq head-ref))) + ;; It is invalid for a branch name to begin with a colon, yet + ;; that is what Gitlab uses when a pull-request's source branch + ;; has been deleted. On Github this is simply nil in the same + ;; situation. + (and branch (not (string-prefix-p ":" branch)) branch))) + +(defun forge--pullreq-branch-active (pullreq) + (let* ((number (number-to-string (oref pullreq number))) + (branch-n (format "pr-%s" number)) + (branch (forge--pullreq-branch-internal pullreq))) + (or (and (magit-branch-p branch) + (equal (magit-get "branch" branch "pullRequest") number) + branch) + (and (magit-branch-p branch-n) + (equal (magit-get "branch" branch-n "pullRequest") number) + branch-n)))) + +(defun forge--pullreq-ref (pullreq) + (let ((ref (format "refs/pullreqs/%s" (oref pullreq number)))) + (and (magit-rev-verify ref) ref))) + +(defun forge--pullreq-range (pullreq &optional endpoints) + (and-let* ((head (forge--pullreq-ref pullreq))) + (concat (forge--get-remote) "/" (oref pullreq base-ref) + (if endpoints "..." "..") + head))) + +(cl-defmethod forge-get-url ((pullreq forge-pullreq)) + (forge--format pullreq 'pullreq-url-format)) + +(defun forge--pullreq-by-forge-short-link-at-point () + (forge--topic-by-forge-short-link-at-point '("#" "!") #'forge-get-pullreq)) + +;;; Sections + +(defun forge-current-pullreq () + (or (forge-pullreq-at-point) + (and (derived-mode-p 'forge-topic-mode) + (forge-pullreq-p forge-buffer-topic) + forge-buffer-topic) + (and (derived-mode-p 'forge-topic-list-mode) + (let ((topic (forge-get-topic (tabulated-list-get-id)))) + (and (forge-pullreq-p topic) + topic))))) + +(defun forge-pullreq-at-point () + (or (magit-section-value-if 'pullreq) + (and-let* ((post (magit-section-value-if 'post))) + (cond ((forge-pullreq-p post) + post) + ((forge-pullreq-post-p post) + (forge-get-pullreq post)))) + (forge--pullreq-by-forge-short-link-at-point))) + +(defvar-keymap forge-pullreqs-section-map + " " #'forge-browse-pullreqs + " " #'forge-list-pullreqs + "C-c C-n" #'forge-create-pullreq) + +(defvar-keymap forge-pullreq-section-map + " " #'forge-browse-pullreq + " " #'forge-visit-pullreq) + +(defun forge-insert-pullreqs () + "Insert a list of mostly recent and/or open pull-requests. +Also see option `forge-topic-list-limit'." + (when (and forge-display-in-status-buffer (forge-db t)) + (when-let ((repo (forge-get-repository nil))) + (unless (oref repo sparse-p) + (forge-insert-topics "Pull requests" + (forge-ls-recent-topics repo 'pullreq) + (forge--topic-type-prefix repo 'pullreq)))))) + +(defun forge--insert-pullreq-commits (pullreq &optional all) + (cl-letf (((symbol-function #'magit-cancel-section) (lambda ()))) + (if all + ;; Numeric pr ref, pr branch (if it exists) and api + ;; pr range may be out of sync. Just show them all. + (magit-insert-section-body + (magit--insert-log nil + (delq nil (list (concat "^" (or (oref pullreq base-rev) + (concat (forge--get-remote) "/" + (oref pullreq base-ref)))) + (forge--pullreq-ref pullreq) + (forge--pullreq-branch-active pullreq) + (and-let* ((branch (oref pullreq head-ref))) + (and (magit-local-branch-p branch) branch)))) + (seq-uniq (cons "--graph" magit-buffer-log-args))) + (magit-make-margin-overlay nil t)) + (when-let ((range (forge--pullreq-range pullreq))) + (magit-insert-section-body + (magit--insert-log nil range magit-buffer-log-args) + (magit-make-margin-overlay nil t)))))) + +(cl-defmethod forge--insert-topic-contents :after ((pullreq forge-pullreq) + _width _prefix) + (unless (oref pullreq merged) + (magit-insert-heading) + (forge--insert-pullreq-commits pullreq))) + +(cl-defmethod forge--format-topic-id ((pullreq forge-pullreq) &optional prefix) + (propertize (format "%s%s" + (or prefix (forge--topic-type-prefix pullreq)) + (oref pullreq number)) + 'font-lock-face (if (oref pullreq merged) + 'forge-topic-merged + 'forge-topic-unmerged))) + +(cl-defmethod forge--topic-type-prefix ((pullreq forge-pullreq)) + (if (forge--childp (forge-get-repository pullreq) 'forge-gitlab-repository) + "!" + "#")) + +(defun forge-insert-assigned-pullreqs () + "Insert a list of open pull-requests that are assigned to you." + (when forge-display-in-status-buffer + (when-let ((repo (forge-get-repository nil))) + (unless (oref repo sparse-p) + (forge-insert-topics "Assigned pull requests" + (forge--ls-assigned-pullreqs repo) + (forge--topic-type-prefix repo 'pullreq)))))) + +(defun forge--ls-assigned-pullreqs (repo) + (mapcar (lambda (row) + (closql--remake-instance 'forge-pullreq (forge-db) row)) + (forge-sql + [:select $i1 :from pullreq + :join pullreq_assignee :on (= pullreq_assignee:pullreq pullreq:id) + :join assignee :on (= pullreq_assignee:id assignee:id) + :where (and (= pullreq:repository $s2) + (= assignee:login $s3) + (isnull pullreq:closed)) + :order-by [(desc updated)]] + (vconcat (closql--table-columns (forge-db) 'pullreq t)) + (oref repo id) + (ghub--username repo)))) + +(defun forge-insert-requested-reviews () + "Insert a list of pull-requests that are awaiting your review." + (when-let ((repo (forge-get-repository nil))) + (unless (oref repo sparse-p) + (forge-insert-topics "Pull requests awaiting review" + (forge--ls-requested-reviews repo) + (forge--topic-type-prefix repo 'pullreq))))) + +(defun forge--ls-requested-reviews (repo) + (mapcar + (lambda (row) + (closql--remake-instance 'forge-pullreq (forge-db) row)) + (forge-sql + [:select $i1 :from pullreq + :join pullreq_review_request :on (= pullreq_review_request:pullreq pullreq:id) + :join assignee :on (= pullreq_review_request:id assignee:id) + :where (and (= pullreq:repository $s2) + (= assignee:login $s3) + (isnull pullreq:closed)) + :order-by [(desc updated)]] + (vconcat (closql--table-columns (forge-db) 'pullreq t)) + (oref repo id) + (ghub--username repo)))) + +(defun forge-insert-authored-pullreqs () + "Insert a list of open pullreqs that are authored to you." + (when forge-display-in-status-buffer + (when-let ((repo (forge-get-repository nil))) + (unless (oref repo sparse-p) + (forge-insert-topics "Authored pullreqs" + (forge--ls-authored-pullreqs repo) + (forge--topic-type-prefix repo 'pullreq)))))) + +(defun forge--ls-authored-pullreqs (repo) + (mapcar (lambda (row) + (closql--remake-instance 'forge-pullreq (forge-db) row)) + (forge-sql + [:select $i1 :from [pullreq] + :where (and (= pullreq:repository $s2) + (= pullreq:author $s3) + (isnull pullreq:closed)) + :order-by [(desc updated)]] + (vconcat (closql--table-columns (forge-db) 'pullreq t)) + (oref repo id) + (ghub--username repo)))) + +;;; _ +(provide 'forge-pullreq) +;;; forge-pullreq.el ends here diff --git a/elpa/forge-20230711.1157/forge-repo.el b/elpa/forge-20230711.1157/forge-repo.el new file mode 100644 index 00000000..e3189bf8 --- /dev/null +++ b/elpa/forge-20230711.1157/forge-repo.el @@ -0,0 +1,378 @@ +;;; forge-repo.el --- Repository support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 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) + (sparse-p :initform t) + (created :initform nil) + (updated :initform nil) + (pushed :initform nil) + (parent :initform nil) + (description :initform nil) + (homepage :initform nil) + (default-branch :initform nil) + (archived-p :initform nil) + (fork-p :initform nil) + (locked-p :initform nil) + (mirror-p :initform nil) + (private-p :initform nil) + (issues-p :initform t) + (wiki-p :initform nil) + (stars :initform nil) + (watchers :initform nil) + (assignees :closql-table assignee) + (forks :closql-table fork) + (issues :closql-class forge-issue) + (labels :closql-table label) + (pullreqs :closql-class forge-pullreq) + (revnotes :closql-class forge-revnote) + (selective-p :initform nil) + (worktree :initform nil) + (milestones :closql-table milestone)) + :abstract t) + +(defclass forge-unusedapi-repository (forge-repository) () :abstract t) + +(defclass forge-noapi-repository (forge-repository) () :abstract t) + +;;; Core + +(cl-defmethod forge--repository-ids ((class (subclass forge-repository)) + host owner name &optional stub) + "Return (OUR-ID . THEIR-ID) of the specified repository. +If optional STUB is non-nil, then the IDs are not guaranteed to +be unique. Otherwise this method has to make an API request to +retrieve THEIR-ID, the repository's ID on the forge. In that +case OUR-ID derives from THEIR-ID and is unique across all +forges and hosts." + (pcase-let* ((`(,_githost ,apihost ,id ,_class) + (or (assoc host forge-alist) + (error "No entry for %S in forge-alist" host))) + (path (format "%s/%s" owner name)) + (their-id (and (not stub) + (ghub-repository-id + owner name + :host apihost + :auth 'forge + :forge (forge--ghub-type-symbol class))))) + (cons (base64-encode-string + (format "%s:%s" id + (cond (stub path) + ((eq class 'forge-github-repository) + ;; This is base64 encoded, according to + ;; https://docs.github.com/en/graphql/reference/scalars#id. + ;; Unfortunately that is not always true. + ;; E.g. https://github.com/dit7ya/roamex. + (condition-case nil + (base64-decode-string their-id) + (error their-id))) + (t their-id))) + t) + (or their-id path)))) + +(cl-defmethod forge--repository-ids ((_class (subclass forge-noapi-repository)) + host owner name &optional _stub) + (let ((their-id (if owner (concat owner "/" name) name))) + (cons (base64-encode-string + (format "%s:%s" + (nth 3 (or (assoc host forge-alist) + (error "No entry for %S in forge-alist" host))) + their-id) + t) + their-id))) + +(defvar-local forge-buffer-repository nil) +(put 'forge-buffer-repository 'permanent-local t) + +(defconst forge--signal-no-entry '(t stub create)) + +(defun forge--get-remote (&optional warn) + (let* ((remotes (magit-list-remotes)) + (config (magit-get "forge.remote")) + (remote (if (cdr remotes) + (or (car (member config remotes)) + (car (member "upstream" remotes)) + (car (member "origin" remotes))) + (car remotes)))) + (when (and warn config remote (not (equal config remote))) + (message "Ignored forge.remote=%s; no such remote.\nSee %s." config + "https://magit.vc/manual/forge/Repository-Detection.html")) + remote)) + +(cl-defmethod forge-get-repository (((_ id) (head :id))) + (closql-get (forge-db) id 'forge-repository)) + +(cl-defmethod forge-get-repository ((demand symbol) &optional remote) + "Return the current forge repository. + +If the `forge-buffer-repository' is non-nil, then return that. +Otherwise if `forge-buffer-topic' is non-nil, then return the +repository for that. Finally if both variables are nil, then +return the forge repository corresponding to the current Git +repository, if any." + (or forge-buffer-repository + (and forge-buffer-topic + (forge-get-repository forge-buffer-topic)) + (magit--with-refresh-cache + (list default-directory 'forge-get-repository demand) + (unless remote + (setq remote (forge--get-remote 'warn))) + (if-let ((url (and remote + (magit-git-string "remote" "get-url" remote)))) + (when-let* ((repo (forge-get-repository url remote demand))) + ;; Cannot use and-let* because of debbugs#31840. + (oset repo worktree (magit-toplevel)) + repo) + (when (memq demand forge--signal-no-entry) + (error + "Cannot determine forge repository. %s\nSee %s." + (cond (remote (format "No url configured for %S." remote)) + ((and-let* ((config (magit-get "forge.remote"))) + (format "Value of `forge.remote' is %S but %s" + config "that remote does not exist."))) + ((magit-list-remotes) "Cannot decide on remote to use.") + (t "No remote configured.")) + "https://magit.vc/manual/forge/Repository-Detection.html")))))) + +(cl-defmethod forge-get-repository ((url string) &optional remote demand) + "Return the repository at URL." + (if-let ((parts (forge--split-url url))) + (forge-get-repository parts remote demand) + (when (memq demand forge--signal-no-entry) + (error "Cannot determine forge repository. %s isn't a forge url" url)))) + +(cl-defmethod forge-get-repository (((host owner name) list) + &optional remote demand) + "((host owner name) &optional remote demand) + +Return the repository identified by HOST, OWNER and NAME." + (if-let ((spec (assoc host forge-alist))) + (pcase-let ((`(,githost ,apihost ,forge ,class) spec)) + (let* ((row (car (forge-sql [:select * :from repository + :where (and (= forge $s1) + (= owner $s2) + (= name $s3))] + forge owner name))) + (obj (and row (closql--remake-instance class (forge-db) row)))) + (when obj + (oset obj apihost apihost) + (oset obj githost githost) + (oset obj remote remote)) + (cond ((and (eq demand t) + (or (not obj) + (oref obj sparse-p))) + (error "Cannot use `%s' in %S yet.\n%s" + this-command (magit-toplevel) + "Use `M-x forge-add-repository' before trying again.")) + ((and (eq demand 'full) obj + (oref obj sparse-p)) + (setq obj nil))) + (when (and (memq demand '(stub create)) + (not obj)) + (pcase-let ((`(,id . ,forge-id) + (forge--repository-ids class host owner name + (eq demand 'stub)))) + ;; The repo might have been renamed on the forge. #188 + (unless (setq obj (forge-get-repository (list :id id))) + (setq obj (funcall class + :id id + :forge-id forge-id + :forge forge + :owner owner + :name name + :apihost apihost + :githost githost + :remote remote)) + (when (eq demand 'create) + (closql-insert (forge-db) obj))))) + obj)) + (when (memq demand forge--signal-no-entry) + (error "Cannot determine forge repository. No entry for %S in %s" + host 'forge-alist)))) + +(cl-defmethod forge-get-repository ((repo forge-repository)) + repo) + +;;; Utilities + +(defun forge-repository-at-point () + (magit-section-value-if 'forge-repo)) + +(defun forge-current-repository () + (or (forge-repository-at-point) + (and (derived-mode-p 'forge-repository-list-mode) + (forge-get-repository (list :id (tabulated-list-get-id)))))) + +(cl-defmethod forge-visit ((repo forge-repository)) + (let ((worktree (oref repo worktree))) + (if (and worktree (file-directory-p worktree)) + (magit-status-setup-buffer worktree) + (forge-list-issues (oref repo id))))) + +(defun forge-read-repository (prompt) + (let ((choice (magit-completing-read + prompt + (mapcar (pcase-lambda (`(,host ,owner ,name)) + (format "%s/%s @%s" owner name host)) + (forge-sql [:select [githost owner name] + :from repository])) + nil t nil nil + (and-let* ((default (or (forge-current-repository) + (forge-get-repository nil)))) + (format "%s/%s @%s" + (oref default owner) + (oref default name) + (oref default githost)))))) + (save-match-data + (if (string-match "\\`\\(.+\\)/\\([^/]+\\) @\\(.+\\)\\'" choice) + (list (match-string 3 choice) + (match-string 1 choice) + (match-string 2 choice)) + (error "BUG"))))) + +(defun forge-read-host (prompt &optional class) + (magit-completing-read + prompt + (if class + (-keep (pcase-lambda (`(,githost ,_apihost ,_id ,c)) + (and (child-of-class-p c class) githost)) + forge-alist) + (mapcar #'car forge-alist)) + nil t)) + +(defun forge--as-githost (host) + (or (car (car (cl-member host forge-alist :test #'equal :key #'car))) + (car (car (cl-member host forge-alist :test #'equal :key #'cadr))) + (car (car (cl-member host forge-alist :test #'equal :key #'caddr))) + (user-error "Cannot determine githost for %S" host))) + +(defun forge--as-apihost (host) + (or (cadr (car (cl-member host forge-alist :test #'equal :key #'cadr))) + (cadr (car (cl-member host forge-alist :test #'equal :key #'car))) + (cadr (car (cl-member host forge-alist :test #'equal :key #'caddr))) + (user-error "Cannot determine githost for %S" host))) + +(cl-defmethod forge--topics-until ((repo forge-repository) until table) + (if (oref repo sparse-p) + until + (caar (forge-sql [:select [updated] :from $i1 + :where (= repository $s2) + :order-by [(desc updated)] + :limit 1] + table (oref repo id))))) + +(cl-defmethod forge--format ((repo forge-repository) format-or-slot &optional spec) + (format-spec + (if (symbolp format-or-slot) + (eieio-oref repo format-or-slot) + format-or-slot) + (with-slots (githost owner name) repo + (let ((path (if owner (concat owner "/" name) name))) + `(,@spec + (?h . ,githost) + (?o . ,owner) + (?n . ,name) + (?p . ,path) + (?P . ,(string-replace "/" "%2F" path))))))) + +(cl-defmethod forge-get-url ((repo forge-repository)) + (forge--format (oref repo remote) 'remote-url-format)) + +(defun forge--set-field-callback () + (let ((buf (current-buffer))) + (lambda (&rest _) + (with-current-buffer + (or buf (current-buffer)) + (forge-pull))))) + +(defvar forge--mode-line-buffer nil) + +(defun forge--msg (repo echo done format &rest args) + (let ((msg (apply #'format format args))) + (when repo + (setq msg (string-replace + "REPO" + (concat (oref repo owner) "/" (oref repo name)) + msg))) + (when (and echo msg) + (message "%s%s" msg (if done "...done" "..."))) + (when (buffer-live-p forge--mode-line-buffer) + (with-current-buffer forge--mode-line-buffer + (setq mode-line-process + (if done + nil + (concat " " (propertize msg 'font-lock-face + 'magit-mode-line-process))))) + (force-mode-line-update t)))) + +(cl-defmethod ghub--host ((repo forge-repository)) + (cl-call-next-method (forge--ghub-type-symbol (eieio-object-class repo)))) + +(cl-defmethod ghub--username ((repo forge-repository)) + (let ((sym (forge--ghub-type-symbol (eieio-object-class repo)))) + (cl-call-next-method (ghub--host sym) sym))) + +(defun forge--ghub-type-symbol (class) + (cl-ecase class + ;; This package does not define a `forge-gitlab-http-repository' + ;; class, but we suggest at #9 that users define such a class if + ;; they must connect to a Gitlab instance that uses http instead + ;; of https. + ((forge-gitlab-repository forge-gitlab-http-repository) 'gitlab) + (forge-github-repository 'github) + (forge-gitea-repository 'gitea) + (forge-gogs-repository 'gogs) + (forge-bitbucket-repository 'bitbucket))) + +;;; _ +(provide 'forge-repo) +;;; forge-repo.el ends here diff --git a/elpa/forge-20230711.1157/forge-revnote.el b/elpa/forge-20230711.1157/forge-revnote.el new file mode 100644 index 00000000..b410f81c --- /dev/null +++ b/elpa/forge-20230711.1157/forge-revnote.el @@ -0,0 +1,47 @@ +;;; forge-revnote.el --- Revnote support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 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-20230711.1157/forge-semi.el b/elpa/forge-20230711.1157/forge-semi.el new file mode 100644 index 00000000..dc235adc --- /dev/null +++ b/elpa/forge-20230711.1157/forge-semi.el @@ -0,0 +1,81 @@ +;;; forge-semi.el --- Support for semi-forges -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 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) + +(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-20230711.1157/forge-topic.el b/elpa/forge-20230711.1157/forge-topic.el new file mode 100644 index 00000000..26e7e407 --- /dev/null +++ b/elpa/forge-20230711.1157/forge-topic.el @@ -0,0 +1,977 @@ +;;; forge-topic.el --- Topics support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 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 issues") + (cons (number :tag "Maximal number of open issues") + (number :tag "Maximal number of closed issues")))) + +(defcustom forge-post-heading-format "%a %C\n" + "Format for post headings in topic view. + +The following %-sequences are supported: + +`%a' The forge nickname of the author. +`%c' The absolute creation date. +`%C' The relative creation date." + :package-version '(forge . "0.1.0") + :group 'forge + :type 'string) + +(defcustom forge-post-fill-region t + "Whether to call `fill-region' before displaying forge posts." + :package-version '(forge . "0.1.0") + :group 'forge + :type 'boolean) + +(defcustom forge-bug-reference-hooks + '(find-file-hook + forge-post-mode-hook + git-commit-setup-hook + magit-mode-hook) + "Hooks to which `forge-bug-reference-setup' is added. +This variable has to be customized before `forge' is loaded." + :package-version '(forge . "0.2.0") + :group 'forge + :options '(find-file-hook + forge-post-mode-hook + git-commit-setup-hook + magit-mode-hook) + :type '(list :convert-widget custom-hook-convert-widget)) + +(defvar-local forge-display-in-status-buffer t + "Whether to display topics in the current Magit status buffer.") +(put 'forge-display-in-status-buffer 'permanent-local t) + +(defvar forge-format-avatar-function nil + "Function used to insert avatars in certain locations. +This is experimental and intended for users who wish to +implement such a function themselves. See #447.") + +;;; Faces + +(defface forge-topic-unread + '((t :inherit bold)) + "Face used for title of unread topics." + :group 'forge-faces) + +(defface forge-topic-closed + '((t :inherit magit-dimmed)) + "Face used for title of closed topics." + :group 'forge-faces) + +(defface forge-topic-open + '((t :inherit default)) + "Face used for title of open topics." + :group 'forge-faces) + +(defface forge-topic-merged + '((t :inherit magit-dimmed)) + "Face used for number of merged pull-requests." + :group 'forge-faces) + +(defface forge-topic-unmerged + '((t :inherit magit-dimmed :slant italic)) + "Face used for number of unmerged pull-requests." + :group 'forge-faces) + +(defface forge-topic-label + `((t :box ( :line-width ,(if (>= emacs-major-version 28) (cons -1 -1) -1) + :style released-button))) + "Face used for topic labels." + :group 'forge-faces) + +(defface forge-post-author + '((t :inherit bold)) + "Face used for post author in topic view." + :group 'forge-faces) + +(defface forge-post-date + '((t :inherit italic)) + "Face used for post date in topic view." + :group 'forge-faces) + +;;; Class + +(defclass forge-topic (forge-post) () :abstract t) + +(cl-defmethod forge--object-id ((class (subclass forge-topic)) repo number) + "Return the id for a CLASS object in REPO identified by id NUMBER." + (base64-encode-string + (encode-coding-string + (format "%s:%s%s" + (base64-decode-string (oref repo id)) + (substring (symbol-name class) + (length (oref-default class closql-class-prefix))) + number) + 'utf-8) + t)) + +(cl-defmethod forge--object-id ((prefix string) number-or-id) + (base64-encode-string + (encode-coding-string + (format "%s:%s" + (base64-decode-string prefix) + (if (numberp number-or-id) + number-or-id + ;; Currently every id is base64 encode. Unfortunately + ;; we cannot use the ids of Gitlab labels (see comment + ;; in the respective `forge--update-labels' method), + ;; and have to use their names, which are not encoded. + (or (ignore-errors (base64-decode-string number-or-id)) + number-or-id))) + 'utf-8) + t)) + +;;; Query + +(cl-defmethod forge-get-parent ((topic forge-topic)) + (forge-get-repository topic)) + +(cl-defmethod forge-get-repository ((topic forge-topic)) + (closql-get (forge-db) + (oref topic repository) + 'forge-repository)) + +(cl-defmethod forge-get-topic ((topic forge-topic)) + topic) + +(cl-defmethod forge-get-topic ((repo forge-repository) number-or-id) + (if (numberp number-or-id) + (if (< number-or-id 0) + (forge-get-pullreq repo (abs number-or-id)) + (or (forge-get-issue repo number-or-id) + (forge-get-pullreq repo number-or-id))) + (or (forge-get-issue number-or-id) + (forge-get-pullreq number-or-id)))) + +(cl-defmethod forge-get-topic ((number integer)) + (if (< number 0) + (forge-get-pullreq (abs number)) + (or (forge-get-issue number) + (forge-get-pullreq number)))) + +(cl-defmethod forge-get-topic ((id string)) + (or (forge-get-issue id) + (forge-get-pullreq id))) + +(cl-defmethod forge-ls-recent-topics ((repo forge-repository) table) + (magit--with-repository-local-cache (list 'forge-ls-recent-topics table) + (let* ((id (oref repo id)) + (limit forge-topic-list-limit) + (open-limit (if (consp limit) (car limit) limit)) + (closed-limit (if (consp limit) (cdr limit) limit)) + (topics (forge-sql [:select * :from $i1 + :where (and (= repository $s2) + (notnull unread-p))] + table id))) + (mapc (lambda (row) + (cl-pushnew row topics :test #'equal)) + (if (consp limit) + (forge-sql [:select * :from $i1 + :where (and (= repository $s2) + (isnull closed)) + :order-by [(desc updated)] + :limit $s3] + table id open-limit) + (forge-sql [:select * :from $i1 + :where (and (= repository $s2) + (isnull closed))] + table id))) + (when (> closed-limit 0) + (mapc (lambda (row) + (cl-pushnew row topics :test #'equal)) + (forge-sql [:select * :from $i1 + :where (and (= repository $s2) + (notnull closed)) + :order-by [(desc updated)] + :limit $s3] + table id closed-limit))) + (cl-sort (mapcar (let ((class (if (eq table 'pullreq) + 'forge-pullreq + 'forge-issue))) + (lambda (row) + (closql--remake-instance class (forge-db) row))) + topics) + (cdr forge-topic-list-order) + :key (lambda (it) (eieio-oref it (car forge-topic-list-order))))))) + +(cl-defmethod forge-ls-topics ((repo forge-repository) + class &optional type select) + (let* ((table (oref-default class closql-table)) + (id (oref repo id)) + (rows (pcase-exhaustive type + (`open (forge-sql [:select $i1 :from $i2 + :where (and (= repository $s3) + (isnull closed)) + :order-by [(desc number)]] + (or select '*) table id)) + (`closed (forge-sql [:select $i1 :from $i2 + :where (and (= repository $s3) + (notnull closed)) + :order-by [(desc number)]] + (or select '*) table id)) + (`nil (forge-sql [:select $i1 :from $i2 + :where (= repository $s3) + :order-by [(desc number)]] + (or select '*) table id))))) + (if select + rows + (mapcar (lambda (row) + (closql--remake-instance class (forge-db) row)) + rows)))) + +;;; Utilities + +(cl-defmethod forge--format ((topic forge-topic) slot &optional spec) + (forge--format (forge-get-repository topic) slot + `(,@spec (?i . ,(oref topic number))))) + +(cl-defmethod forge-visit ((topic forge-topic)) + (forge-topic-setup-buffer topic) + (forge-topic-mark-read (forge-get-repository topic) topic)) + +(cl-defmethod forge-topic-mark-read ((_ forge-repository) topic) + (oset topic unread-p nil)) + +(defun forge--sanitize-string (string) + ;; For Gitlab this may also be nil. + (if string (string-replace "\r\n" "\n" string) "")) + +(defun forge-insert-topics (heading topics prefix) + "Under a new section with HEADING, insert TOPICS." + (when topics + (let ((width (apply #'max + (--map (length (number-to-string (oref it number))) + topics))) + list-section-type topic-section-type) + (cond ((forge--childp (car topics) 'forge-issue) + (setq list-section-type 'issues) + (setq topic-section-type 'issue)) + ((forge--childp (car topics) 'forge-pullreq) + (setq list-section-type 'pullreqs) + (setq topic-section-type 'pullreq))) + (magit-insert-section ((eval list-section-type) nil t) + (magit-insert-heading + (concat (magit--propertize-face (concat heading " ") + 'magit-section-heading) + (magit--propertize-face (format "(%s)" (length topics)) + 'magit-section-child-count))) + (magit-make-margin-overlay nil t) + (magit-insert-section-body + (dolist (topic topics) + (forge-insert-topic topic topic-section-type width prefix)) + (insert ?\n) + (magit-make-margin-overlay nil t)))))) + +(defun forge-insert-topic (topic &optional topic-section-type width prefix) + "Insert TOPIC as a new section. +If TOPIC-SECTION-TYPE is provided, it is the section type to use. +If WIDTH is provided, it is a fixed width to use for the topic +identifier." + (unless topic-section-type + (setq topic-section-type + (cond ((forge--childp topic 'forge-issue) 'issue) + ((forge--childp topic 'forge-pullreq) 'pullreq)))) + (magit-insert-section ((eval topic-section-type) topic t) + (forge--insert-topic-contents topic width prefix))) + +(cl-defmethod forge--format-topic-id ((topic forge-topic) &optional prefix) + (propertize (format "%s%s" + (or prefix (forge--topic-type-prefix topic)) + (oref topic number)) + 'font-lock-face 'magit-dimmed)) + +(cl-defmethod forge--insert-topic-contents ((topic forge-topic) width prefix) + (with-slots (number title unread-p closed) topic + (insert (format (if width (format "%%-%is" (1+ width)) "%s") + (forge--format-topic-id topic prefix))) + (forge--insert-topic-marks topic) + (insert " ") + (insert (magit-log-propertize-keywords + nil (propertize title 'font-lock-face + (cond (unread-p 'forge-topic-unread) + (closed 'forge-topic-closed) + (t 'forge-topic-open))))) + (forge--insert-topic-labels topic) + (insert "\n") + (magit-log-format-author-margin + (oref topic author) + (format-time-string "%s" (parse-iso8601-time-string (oref topic created))) + t))) + +(defun forge--topic-by-forge-short-link-at-point (known-prefixes finder) + "Finds a topic by forge-dependant short link around point. +The topic number is expected to be a number prefixed by any of +the elements in KNOWN-PREFIXES. If a reference is found, FINDER +is called and a topic object is returned if available." + (and-let* ((number (number-at-point)) + (prefix (buffer-substring-no-properties + (- (match-beginning 0) 1) + (match-beginning 0)))) + (and (member prefix known-prefixes) + (funcall finder number)))) + +;;; Mode + +(defvar-keymap forge-topic-mode-map + "C-c C-n" #'forge-create-post + "C-c C-r" #'forge-create-post + " " #'forge-browse-topic + " " #'markdown-follow-link-at-point + "" #'markdown-follow-link-at-point) + +(define-derived-mode forge-topic-mode magit-mode "View Topic" + "View a forge issue or pull-request." + (setq-local markdown-translate-filename-function + #'forge--markdown-translate-filename-function)) + +(defvar forge-topic-headers-hook + '(forge-insert-topic-title + forge-insert-topic-state + forge-insert-topic-draft + forge-insert-topic-refs + forge-insert-topic-milestone + forge-insert-topic-labels + forge-insert-topic-marks + forge-insert-topic-assignees + forge-insert-topic-review-requests)) + +(defvar-keymap forge-post-section-map + " " #'forge-browse-post + " " #'forge-edit-post + "C-c C-k" #'forge-delete-comment) + +(defvar-local forge-buffer-topic nil) +(defvar-local forge-buffer-topic-ident nil) + +(defun forge-topic-setup-buffer (topic) + (let* ((repo (forge-get-repository topic)) + (ident (concat (forge--topic-type-prefix topic) + (number-to-string (oref topic number)))) + (name (format "*forge: %s/%s %s*" + (oref repo owner) + (oref repo name) + ident)) + (magit-generate-buffer-name-function (lambda (_mode _value) name)) + (current-repo (forge-get-repository nil)) + (default-directory (if (and current-repo + (eq (oref current-repo id) + (oref repo id))) + default-directory + (or (oref repo worktree) + default-directory)))) + (magit-setup-buffer #'forge-topic-mode t + (forge-buffer-topic topic) + (forge-buffer-topic-ident ident)))) + +(defun forge-topic-refresh-buffer () + (let ((topic (closql-reload forge-buffer-topic))) + (setq forge-buffer-topic topic) + (magit-set-header-line-format + (format "%s: %s" forge-buffer-topic-ident (oref topic title))) + (magit-insert-section (topicbuf) + (magit-insert-headers 'forge-topic-headers-hook) + (when (forge-pullreq-p topic) + (magit-insert-section (pullreq topic) + (magit-insert-heading "Commits") + (forge--insert-pullreq-commits topic t))) + (when-let ((note (oref topic note))) + (magit-insert-section (note) + (magit-insert-heading "Note") + (insert (forge--fontify-markdown note) "\n\n"))) + (dolist (post (cons topic (oref topic posts))) + (with-slots (author created body) post + (magit-insert-section section (post post) + (oset section heading-highlight-face + 'magit-diff-hunk-heading-highlight) + (let ((heading + (format-spec + forge-post-heading-format + `((?a . ,(propertize (concat (forge--format-avatar author) + (or author "(ghost)")) + 'font-lock-face 'forge-post-author)) + (?c . ,(propertize created 'font-lock-face 'forge-post-date)) + (?C . ,(propertize (apply #'format "%s %s ago" + (magit--age + (float-time + (date-to-time created)))) + 'font-lock-face 'forge-post-date)))))) + (font-lock-append-text-property + 0 (length heading) + 'font-lock-face 'magit-diff-hunk-heading heading) + (magit-insert-heading heading)) + (insert (forge--fontify-markdown body) "\n\n")))) + (when (and (display-images-p) + (fboundp 'markdown-display-inline-images)) + (let ((markdown-display-remote-images t)) + (markdown-display-inline-images)))))) + +(cl-defmethod magit-buffer-value (&context (major-mode forge-topic-mode)) + forge-buffer-topic-ident) + +(defvar-keymap forge-topic-title-section-map + " " #'forge-edit-topic-title) + +(cl-defun forge-insert-topic-title + (&optional (topic forge-buffer-topic)) + (magit-insert-section (topic-title) + (insert (format "%-11s" "Title: ") (oref topic title) "\n"))) + +(defvar-keymap forge-topic-state-section-map + " " #'forge-edit-topic-state) + +(cl-defun forge-insert-topic-state + (&optional (topic forge-buffer-topic)) + (magit-insert-section (topic-state) + (insert (format + "%-11s%s\n" "State: " + (let ((state (oref topic state))) + (magit--propertize-face + (symbol-name state) + (pcase (list state (forge-pullreq-p (forge-topic-at-point))) + ('(merged) 'forge-topic-merged) + ('(closed) 'forge-topic-closed) + ('(open t) 'forge-topic-unmerged) + ('(open) 'forge-topic-open)))))))) + +(defvar-keymap forge-topic-draft-section-map + " " #'forge-edit-topic-draft) + +(cl-defun forge-insert-topic-draft + (&optional (topic forge-buffer-topic)) + (when (forge-pullreq-p topic) + (magit-insert-section (topic-draft) + (insert (format "%-11s%s\n" "Draft: " (oref topic draft-p)))))) + +(defvar-keymap forge-topic-milestone-section-map + " " #'forge-edit-topic-milestone) + +(cl-defun forge-insert-topic-milestone + (&optional (topic forge-buffer-topic)) + (magit-insert-section (topic-milestone) + (insert (format "%-11s" "Milestone: ") + (or (forge--get-topic-milestone topic) + ;; If the user hasn't pulled this repository yet after + ;; updating to db v7, then only the id is available. + (oref topic milestone) + (propertize "none" 'font-lock-face 'magit-dimmed)) + "\n"))) + +(defun forge--get-topic-milestone (topic) + (and-let* ((id (oref topic milestone))) + (caar (forge-sql [:select [title] :from milestone :where (= id $s1)] id)))) + +(defvar-keymap forge-topic-labels-section-map + " " #'forge-edit-topic-labels) + +(cl-defun forge-insert-topic-labels + (&optional (topic forge-buffer-topic)) + (magit-insert-section (topic-labels) + (insert (format "%-11s" "Labels: ")) + (if-let ((labels (closql--iref topic 'labels))) + (forge--insert-topic-labels topic t labels) + (insert (propertize "none" 'font-lock-face 'magit-dimmed))) + (insert ?\n))) + +(defun forge--format-topic-labels (topic) + (and-let* ((labels (closql--iref topic 'labels))) + (mapconcat (pcase-lambda (`(,name ,color ,_desc)) + (propertize name 'font-lock-face (list :box color))) + labels " "))) + +(defun forge--insert-topic-labels (topic &optional skip-separator labels) + (pcase-dolist (`(,name ,color ,description) + (or labels (closql--iref topic 'labels))) + (if skip-separator + (setq skip-separator nil) + (insert " ")) + (let* ((background (forge--sanitize-color color)) + (foreground (forge--contrast-color background))) + (insert name) + (let ((o (make-overlay (- (point) (length name)) (point)))) + (overlay-put o 'priority 2) + (overlay-put o 'evaporate t) + (overlay-put o 'font-lock-face + `(( :background ,background + :foreground ,foreground) + forge-topic-label)) + (when description + (overlay-put o 'help-echo description)))))) + +(defvar-keymap forge-topic-marks-section-map + " " #'forge-edit-topic-marks) + +(cl-defun forge-insert-topic-marks + (&optional (topic forge-buffer-topic)) + (magit-insert-section (topic-marks) + (insert (format "%-11s" "Marks: ")) + (if-let ((marks (closql--iref topic 'marks))) + (forge--insert-topic-marks topic t marks) + (insert (propertize "none" 'font-lock-face 'magit-dimmed))) + (insert ?\n))) + +(defun forge--insert-topic-marks (topic &optional skip-separator marks) + (pcase-dolist (`(,name ,face ,description) + (or marks (closql--iref topic 'marks))) + (if skip-separator + (setq skip-separator nil) + (insert " ")) + (insert name) + (let ((o (make-overlay (- (point) (length name)) (point)))) + (overlay-put o 'priority 2) + (overlay-put o 'evaporate t) + (overlay-put o 'font-lock-face (list face 'forge-topic-label)) + (when description + (overlay-put o 'help-echo description))))) + +(defun forge--sanitize-color (color) + (cond ((x-color-values color) color) + ;; Discard alpha information. + ((string-match-p "\\`#.\\{4\\}\\'" color) (substring color 0 3)) + ((string-match-p "\\`#.\\{8\\}\\'" color) (substring color 0 6)) + (t "#000000"))) ; Use fallback instead of invalid color. + +(defun forge--contrast-color (color) + "Return black or white depending on the luminance of COLOR." + (if (> (forge--x-color-luminance color) 0.5) "black" "white")) + +;; Copy of `rainbow-x-color-luminance'. +(defun forge--x-color-luminance (color) + "Calculate the luminance of a color string (e.g. \"#ffaa00\", \"blue\"). +Return a value between 0 and 1." + (let ((values (x-color-values color))) + (forge--color-luminance (/ (nth 0 values) 256.0) + (/ (nth 1 values) 256.0) + (/ (nth 2 values) 256.0)))) + +;; Copy of `rainbow-color-luminance'. +;; Also see https://en.wikipedia.org/wiki/Relative_luminance. +(defun forge--color-luminance (red green blue) + "Calculate the luminance of color composed of RED, GREEN and BLUE. +Return a value between 0 and 1." + (/ (+ (* .2126 red) (* .7152 green) (* .0722 blue)) 256)) + +(cl-defun forge-insert-topic-refs + (&optional (topic forge-buffer-topic)) + (when (forge-pullreq-p topic) + (magit-insert-section (topic-refs) + (with-slots (cross-repo-p base-repo base-ref head-repo head-ref) topic + (let ((separator (propertize ":" 'font-lock-face 'magit-dimmed)) + (deleted (propertize "(deleted)" 'font-lock-face 'magit-dimmed))) + (insert (format "%-11s" "Refs: ") + (if cross-repo-p + (concat base-repo separator base-ref) + base-ref) + (propertize "..." 'font-lock-face 'magit-dimmed) + (if cross-repo-p + (if (and head-repo head-ref) + (concat head-repo separator head-ref) + deleted) + (or head-ref deleted)) + "\n")))))) + +(defvar-keymap forge-topic-assignees-section-map + " " #'forge-edit-topic-assignees) + +(cl-defun forge-insert-topic-assignees + (&optional (topic forge-buffer-topic)) + (magit-insert-section (topic-assignees) + (insert (format "%-11s" "Assignees: ")) + (if-let ((assignees (closql--iref topic 'assignees))) + (insert (mapconcat (pcase-lambda (`(,login ,name)) + (format "%s%s (@%s)" + (forge--format-avatar login) + name login)) + assignees ", ")) + (insert (propertize "none" 'font-lock-face 'magit-dimmed))) + (insert ?\n))) + +(defvar-keymap forge-topic-review-requests-section-map + " " #'forge-edit-topic-review-requests) + +(cl-defun forge-insert-topic-review-requests + (&optional (topic forge-buffer-topic)) + (when (forge-pullreq-p topic) + (magit-insert-section (topic-review-requests) + (insert (format "%-11s" "Review-Requests: ")) + (if-let ((review-requests (closql--iref topic 'review-requests))) + (insert (mapconcat (pcase-lambda (`(,login ,name)) + (format "%s%s (@%s)" + (forge--format-avatar login) + name login)) + review-requests ", ")) + (insert (propertize "none" 'font-lock-face 'magit-dimmed))) + (insert ?\n)))) + +(defun forge--fontify-markdown (text) + (with-temp-buffer + (delay-mode-hooks + (gfm-mode)) + (insert text) + (font-lock-ensure) + (when forge-post-fill-region + (fill-region (point-min) (point-max))) + (buffer-string))) + +(cl-defmethod forge--topic-type-prefix ((_ forge-topic)) + "Get the identifier prefix specific to the type of TOPIC." + "#") + +(cl-defmethod forge--topic-type-prefix ((_repo forge-repository) _type) + "#") + +(defun forge--markdown-translate-filename-function (file) + (if (string-match-p "\\`https?://" file) + file + (let ((host (oref (forge-get-repository t) githost))) + (concat (if (member host ghub-insecure-hosts) "http://" "https://") + host + (and (not (string-prefix-p "/" file)) "/") + file)))) + +(defun forge--format-avatar (author) + (if forge-format-avatar-function + (funcall forge-format-avatar-function author) + "")) + +;;; Completion + +(defun forge-read-topic (prompt &optional type allow-number) + (when (eq type t) + (setq type (if current-prefix-arg nil 'open))) + (let* ((default (forge-current-topic)) + (repo (forge-get-repository (or default t))) + (choices (mapcar + (apply-partially #'forge--topic-format-choice repo) + (cl-sort + (nconc + (forge-ls-pullreqs repo type [number title id class]) + (forge-ls-issues repo type [number title id class])) + #'> :key #'car))) + (choice (magit-completing-read + prompt choices nil nil nil nil + (and default + (setq default (forge--topic-format-choice default)) + (member default choices) + (car default))))) + (or (cdr (assoc choice choices)) + (and allow-number + (let ((number (string-to-number choice))) + (if (= number 0) + (user-error "Not an existing topic or number: %s") + number)))))) + +(cl-defmethod forge--topic-format-choice ((topic forge-topic)) + (cons (format "%s%s %s" + (forge--topic-type-prefix topic) + (oref topic number) + (oref topic title)) + (oref topic id))) + +(cl-defmethod forge--topic-format-choice ((repo forge-repository) args) + (pcase-let ((`(,number ,title ,id ,class) args)) + (cons (format "%s%s %s" + (forge--topic-type-prefix repo class) + number + title) + id))) + +(defun forge-topic-completion-at-point () + (let ((bol (line-beginning-position)) + repo) + (and (looking-back "[!#][0-9]*" bol) + (or (not bug-reference-prog-mode) + (nth 8 (syntax-ppss))) ; inside comment or string + (setq repo (forge-get-repository t)) + (looking-back (if (forge--childp repo 'forge-gitlab-repository) + "\\(?3:[!#]\\)\\(?2:[0-9]*\\)" + "#\\(?2:[0-9]*\\)") + bol) + (list (match-beginning 2) + (match-end 0) + (mapcar (lambda (row) + (propertize (number-to-string (car row)) + :title (format " %s" (cadr row)))) + (if (forge--childp repo 'forge-gitlab-repository) + (forge-sql [:select [number title] + :from $i1 + :where (= repository $s2) + :order-by [(desc updated)]] + (if (equal (match-string 3) "#") + 'issue + 'pullreq) + (oref repo id)) + (forge-sql [:select [number title updated] + :from pullreq + :where (= repository $s1) + :union + :select [number title updated] + :from issue + :where (= repository $s1) + :order-by [(desc updated)]] + (oref repo id)))) + :annotation-function (lambda (c) (get-text-property 0 :title c)))))) + +;;; Parse + +(defun forge--topic-parse-buffer (&optional file) + (save-match-data + (save-excursion + (goto-char (point-min)) + (let ((alist (save-excursion (forge--topic-parse-yaml)))) + (if alist + (setf (alist-get 'yaml alist) t) + (setq alist (save-excursion (forge--topic-parse-plain)))) + (setf (alist-get 'file alist) file) + (setf (alist-get 'text alist) (magit--buffer-string nil nil ?\n)) + (when (and file (not (alist-get 'prompt alist))) + (setf (alist-get 'prompt alist) + (file-name-sans-extension (file-name-nondirectory file)))) + ;; If there is a yaml front-matter, then it is supposed + ;; to have a `title' field, but this may not be the case. + (when (and (not file) + (not (alist-get 'title alist))) + (setf (alist-get 'title alist) + (read-string "Title: "))) + alist)))) + +(defun forge--topic-parse-yaml () + (let (alist beg end) + (when (looking-at "^---[\s\t]*$") + (forward-line) + (setq beg (point)) + (when (re-search-forward "^---[\s\t]*$" nil t) + (setq end (match-beginning 0)) + (setq alist (yaml-parse-string + (buffer-substring-no-properties beg end) + :object-type 'alist + :sequence-type 'list + ;; FIXME Does not work because of + ;; https://github.com/zkry/yaml.el/pull/28. + :false-object nil)) + (let-alist alist + (when (and .name .about) + (setf (alist-get 'prompt alist) + (format "[%s] %s" .name .about))) + (when (and .labels (atom .labels)) + (setf (alist-get 'labels alist) (list .labels))) + (when (and .assignees (atom .assignees)) + (setf (alist-get 'assignees alist) (list .assignees)))) + (forward-line) + (when (and (not (alist-get 'title alist)) + (looking-at "^\n?#*")) + (goto-char (match-end 0)) + (setf (alist-get 'title alist) + (string-trim + (magit--buffer-string (point) (line-end-position) t))) + (forward-line)) + (setf (alist-get 'body alist) + (string-trim (magit--buffer-string (point) nil ?\n))))) + alist)) + +(defun forge--topic-parse-plain () + (let (title body) + (when (looking-at "\\`#*") + (goto-char (match-end 0))) + (setq title (magit--buffer-string (point) (line-end-position) t)) + (forward-line) + (setq body (magit--buffer-string (point) nil ?\n)) + `((title . ,(string-trim title)) + (body . ,(string-trim body))))) + +(defun forge--topic-parse-link-buffer () + (save-match-data + (save-excursion + (goto-char (point-min)) + (mapcar (lambda (alist) + (cons (cons 'prompt (concat (alist-get 'name alist) " -- " + (alist-get 'about alist))) + alist)) + (forge--topic-parse-yaml-links))))) + +(defun forge--topic-parse-yaml-links () + (alist-get 'contact_links + (yaml-parse-string (buffer-substring-no-properties + (point-min) + (point-max)) + :object-type 'alist + :sequence-type 'list))) + +;;; Templates + +(cl-defgeneric forge--topic-templates (repo class) + "Return a list of topic template files for REPO and a topic of CLASS.") + +(cl-defgeneric forge--topic-template (repo class) + "Return a topic template alist for REPO and a topic of CLASS. +If there are multiple templates, then the user is asked to select +one of them. It there are no templates, then return a very basic +alist, containing just `text' and `position'.") + +(defun forge--topic-templates-data (repo class) + (let ((branch (oref repo default-branch))) + (mapcan (lambda (f) + (with-temp-buffer + (magit-git-insert "cat-file" "-p" (concat branch ":" f)) + (if (equal (file-name-nondirectory f) "config.yml") + (forge--topic-parse-link-buffer) + (list (forge--topic-parse-buffer f))))) + (forge--topic-templates repo class)))) + +(cl-defmethod forge--topic-template ((repo forge-repository) + (class (subclass forge-topic))) + (let ((choices (forge--topic-templates-data repo class))) + (if (cdr choices) + (let ((c (magit-completing-read + (if (eq class 'forge-pullreq) + "Select pull-request template" + "Select issue template") + (--map (alist-get 'prompt it) choices) + nil t))) + (--first (equal (alist-get 'prompt it) c) choices)) + (car choices)))) + +;;; Bug-Reference + +(when (< emacs-major-version 28) + (defun bug-reference-fontify (start end) + "Apply bug reference overlays to region." + (save-excursion + (let ((beg-line (progn (goto-char start) (line-beginning-position))) + (end-line (progn (goto-char end) (line-end-position)))) + ;; Remove old overlays. + (bug-reference-unfontify beg-line end-line) + (goto-char beg-line) + (while (and (< (point) end-line) + (re-search-forward bug-reference-bug-regexp end-line 'move)) + (when (and (or (not bug-reference-prog-mode) + ;; This tests for both comment and string syntax. + (nth 8 (syntax-ppss))) + ;; This is the part where this redefinition differs + ;; from the original defined in "bug-reference.el". + (not (and (derived-mode-p 'magit-status-mode + 'forge-notifications-mode) + (= (match-beginning 0) + (line-beginning-position)))) + ;; End of additions. + ) + (let ((overlay (make-overlay (match-beginning 0) (match-end 0) + nil t nil))) + (overlay-put overlay 'category 'bug-reference) + ;; Don't put a link if format is undefined + (when bug-reference-url-format + (overlay-put overlay 'bug-reference-url + (if (stringp bug-reference-url-format) + (format bug-reference-url-format + (match-string-no-properties 2)) + (funcall bug-reference-url-format))))))))))) + +(defun forge-bug-reference-setup () + "Setup `bug-reference' in the current buffer. +If forge data has been fetched for the current repository, then +enable `bug-reference-mode' or `bug-reference-prog-mode' and +modify `bug-reference-bug-regexp' if appropriate." + (unless (or bug-reference-url-format + (not (forge-db t))) + (magit--with-safe-default-directory nil + (when-let ((repo (forge-get-repository 'full))) + (if (>= emacs-major-version 28) + (when (derived-mode-p 'magit-status-mode + 'forge-notifications-mode) + (setq-local + bug-reference-auto-setup-functions + (let ((hook bug-reference-auto-setup-functions)) + (list (lambda () + ;; HOOK is not allowed to be a lexical var: + ;; (run-hook-with-args-until-success 'hook) + (catch 'success + (dolist (f hook) + (when (funcall f) + (setq bug-reference-bug-regexp + (concat "." bug-reference-bug-regexp)) + (throw 'success t))))))))) + (setq-local bug-reference-url-format + (if (forge--childp repo 'forge-gitlab-repository) + (lambda () + (forge--format repo + (if (equal (match-string 3) "#") + 'issue-url-format + 'pullreq-url-format) + `((?i . ,(match-string 2))))) + (forge--format repo 'issue-url-format '((?i . "%s"))))) + (setq-local bug-reference-bug-regexp + (if (forge--childp repo 'forge-gitlab-repository) + "\\(?3:[!#]\\)\\(?2:[0-9]+\\)" + "#\\(?2:[0-9]+\\)"))) + (if (derived-mode-p 'prog-mode) + (bug-reference-prog-mode 1) + (bug-reference-mode 1)) + (add-hook 'completion-at-point-functions + #'forge-topic-completion-at-point nil t))))) + +(unless noninteractive + (dolist (hook forge-bug-reference-hooks) + (add-hook hook #'forge-bug-reference-setup))) + +;;; _ +(provide 'forge-topic) +;;; forge-topic.el ends here diff --git a/elpa/forge-20230711.1157/forge.el b/elpa/forge-20230711.1157/forge.el new file mode 100644 index 00000000..592f055f --- /dev/null +++ b/elpa/forge-20230711.1157/forge.el @@ -0,0 +1,169 @@ +;;; forge.el --- Access Git forges from Magit -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 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-list) + +;;; Add Sections + +(defvar forge-add-default-sections t + "Whether to add Forge's sections to `magit-status-sections-hook'. +If you want to disable this, then you must set this to nil before +`forge' is loaded.") + +(when forge-add-default-sections + (magit-add-section-hook 'magit-status-sections-hook #'forge-insert-pullreqs nil t) + (magit-add-section-hook 'magit-status-sections-hook #'forge-insert-issues nil t)) + +;;; Add Bindings + +;;;###autoload +(defvar forge-add-default-bindings t + "Whether to add Forge's bindings to various Magit keymaps. + +If you want to disable this, then you must set this to nil before +`magit' is loaded. If you do it before `forge' but after `magit' +is loaded, then `magit-mode-map' ends up being modified anyway. + +If this is nil, then `forge-toggle-display-in-status-buffer' can +no longer do its job. It might be better to set the global value +of `forge-display-in-status-buffer' to nil instead. That way you +can still display topics on demand in the status buffer.") + +;;;###autoload +(with-eval-after-load 'git-commit + (when forge-add-default-bindings + (define-key git-commit-mode-map (kbd "C-c C-v") #'forge-visit-topic))) + +;;;###autoload +(with-eval-after-load 'magit-mode + (when forge-add-default-bindings + (define-key magit-mode-map "'" #'forge-dispatch) + (define-key magit-mode-map "N" #'forge-dispatch))) + +(when forge-add-default-bindings + (define-key magit-commit-section-map [remap magit-browse-thing] #'forge-browse-dwim) + (define-key magit-remote-section-map [remap magit-browse-thing] #'forge-browse-remote) + (define-key magit-branch-section-map [remap magit-browse-thing] #'forge-browse-branch) + + (define-key magit-commit-section-map (kbd "C-c C-v") #'forge-visit-topic) + (define-key magit-branch-section-map (kbd "C-c C-v") #'forge-visit-topic) + + (transient-insert-suffix 'magit-dispatch "o" + '("N" "Forge" forge-dispatch)) + + (transient-append-suffix 'magit-fetch "m" + '("n" "forge topics" forge-pull)) + (transient-append-suffix 'magit-fetch "n" + '("N" "forge notifications" forge-pull-notifications)) + + (transient-append-suffix 'magit-pull "m" + '("n" "forge topics" forge-pull)) + (transient-append-suffix 'magit-pull "n" + '("N" "forge notifications" forge-pull-notifications)) + + (transient-append-suffix 'magit-branch "w" + '("f" "pull-request" forge-checkout-pullreq)) + (transient-append-suffix 'magit-branch "W" + '("F" "from pull-request" forge-branch-pullreq)) + + (transient-suffix-put 'magit-remote 'magit-update-default-branch :key "b u") + (transient-append-suffix 'magit-remote "b u" + '("b r" "Rename default branch" forge-rename-default-branch)) + + (transient-append-suffix 'magit-worktree "c" + '("n" "pull-request worktree" forge-checkout-worktree)) + + (transient-append-suffix 'magit-status-jump "w" + '("Np" "Pull requests" forge-jump-to-pullreqs)) + (transient-append-suffix 'magit-status-jump "Np" + '("Ni" "Issues" forge-jump-to-issues)) + + (transient-append-suffix 'magit-merge "a" + '(7 "M" "Merge using API" forge-merge))) + +;;; Startup Asserts + +(defconst forge--minimal-git "2.7.0") + +(defun forge-startup-asserts () + (let ((version (magit-git-version))) + (when (and version + (version< version forge--minimal-git) + (not (equal (getenv "TRAVIS") "true"))) + (display-warning 'magit (format "\ +Forge requires Git >= %s, you are using %s. + +If this comes as a surprise to you, because you do actually have +a newer version installed, then that probably means that the +older version happens to appear earlier on the `$PATH'. If you +always start Emacs from a shell, then that can be fixed in the +shell's init file. If you start Emacs by clicking on an icon, +or using some sort of application launcher, then you probably +have to adjust the environment as seen by graphical interface. +For X11 something like ~/.xinitrc should work. + +If you use Tramp to work inside remote Git repositories, then you +have to make sure a suitable Git is used on the remote machines +too.\n" forge--minimal-git version) :error)))) + +(if after-init-time + (forge-startup-asserts) + (add-hook 'after-init-hook #'forge-startup-asserts t)) + +;;; forge.el ends here diff --git a/elpa/forge-20230711.1157/forge.info b/elpa/forge-20230711.1157/forge.info new file mode 100644 index 00000000..3e7e302e --- /dev/null +++ b/elpa/forge-20230711.1157/forge.info @@ -0,0 +1,1504 @@ +This is forge.info, produced by makeinfo version 6.7 from forge.texi. + + Copyright (C) 2018-2023 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-2023 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’. + + 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’. + + +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 N’ (‘forge-branch-pullreq’) + This command creates and configures a new branch from a + pull-request, creating and configuring a new remote if necessary. + + The name of the local branch is the same as the name of the remote + branch that you are being asked to merge, unless the contributor + could not be bothered to properly name the branch before opening + the pull-request. The most likely such case is when you are being + asked to merge something like "fork/master" into "origin/master". + In such cases the local branch will be named "pr-N", where ‘N’ is + the pull-request number. + + These variables are always set by this command: + + • ‘branch..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 n’ (‘forge-checkout-pullreq’) + This command creates and configures a new branch from a + pull-request the same way ‘forge-branch-pullreq’ does. + Additionally it checks out the new branch. + +‘Z n’ (‘forge-checkout-worktree’) + This command creates and configures a new branch from a + pull-request the same way ‘forge-branch-pullreq’ does. + Additionally it checks out the new branch using a new working tree. + +User Options: forge-checkout-worktree-read-directory-function + This function is used by ‘forge-checkout-worktree’ to read read the + new worktree directory where it checks out to pull-request. It + takes the pull-request as the only argument and must return a + directory. + + When you delete a pull-request branch, which was created using one of +the above three commands, then ‘magit-branch-delete’ usually offers to +also delete the corresponding remote. It does not offer to delete a +remote if (1) the remote is the upstream remote, and/or (2) if other +branches are being fetched from the remote. + + Note that you have to delete the local branch (e.g. "feature") for +this to work. If you delete the tracking branch (e.g "fork/feature"), +then the remote is never removed. + + +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 two functions to +‘magit-status-sections-hook’: + + -- Function: forge-insert-pullreqs + This function inserts a list of the most recent and/or open + pull-requests. + + -- Function: forge-insert-issues + This function inserts a list of the most recent and/or open issues. + + -- User Option: forge-topic-list-limit + This option limits the number of topics listed by the above + functions. + + All unread topics are always shown. If the value of this option + has the form ‘(OPEN . CLOSED)’, then the integer ‘OPEN’ specifies + the maximal number of topics and ‘CLOSED’ specifies the maximal + number of closed topics. IF ‘CLOSED’ is negative then show no + closed topics until the command ‘forge-toggle-closed-visibility’ + changes the sign. + + -- Command: forge-toggle-closed-visibility + This command toggles whether the above two functions list recently + closed issues in the current buffer. + + The following three functions are also suitable for +‘magit-status-sections-hook’: + + -- Function: forge-insert-assigned-pullreqs + This function inserts a list of open pull-requests that are + assigned to you. + + -- Function: forge-insert-requested-reviews + This function inserts a list of open pull-requests that are + awaiting your review. + + -- Function: forge-insert-authored-pullreqs + This function inserts a list of open pull-requests that are + authored by you. + + -- Function: forge-insert-assigned-issues + This function inserts a list of open issues that are assigned to + you. + + -- Function: forge-insert-authored-issues + This function inserts a list of open issues that are authored by + you. + + The following commands list repositories, notifications and topics in +dedicated buffers: + +‘N l r’ (‘forge-list-repositories’) + This command lists all known repositories in a separate buffer. + +‘N l n’ (‘forge-list-notifications’) + This command lists all notifications for all forges in a separate + buffer. + +‘N l p’ (‘forge-list-pullreqs’) + This command lists the current repository’s pull-requests in a + separate buffer. + +‘N l i’ (‘forge-list-issues’) + This command lists the current repository’s issues in a separate + buffer. + + -- Command: forge-list-labeled-pullreqs + This command lists the current repository’s open pull-requests that + are labeled with a label read from the user. + + -- Command: forge-list-labeled-issues + This command lists the current repository’s open issues that are + labeled with a label read from the user. + + -- Command: forge-list-assigned-pullreqs + This command lists the current repository’s open pull-requests that + are assigned to you in a separate buffer. + + -- Command: forge-list-assigned-issues + This command lists the current repository’s open issues that are + assigned to you in a separate buffer. + + -- Command: forge-list-requested-reviews + This command lists pull-requests of the current repository that are + awaiting your review in a separate buffer. + + -- Command: forge-list-authored-pullreqs + This command lists the current repository’s open pull-requests that + are authored by you in a separate buffer. + + -- Command: forge-list-authored-issues + This command lists the current repository’s open issues that are + authored by you in a separate buffer. + + -- Command: forge-list-owned-pullreqs + This command lists open pull-requests from all the repositories + that you own. Options ‘forge-owned-accounts’ and + ‘forge-owned-ignored’ controls which repositories are considered to + be owned by you. Only Github is supported for now. + + -- Command: forge-list-owned-issues + This command lists open issues from all the repositories that you + own. Options ‘forge-owned-accounts’ and ‘forge-owned-ignored’ + controls which repositories are considered to be owned by you. + Only Github is supported for now. + + -- User Option: forge-owned-accounts + This is an alist of accounts that are owned by you. This should + include your username as well as any organization that you own. + Used by the commands ‘forge-list-owned-issues’, + ‘forge-list-owned-pullreqs’ and ‘forge-fork’. + + Each element has the form ‘(ACCOUNT . PLIST)’. The following + properties are currently being used: + + • ‘remote-name’ The default name suggested by ‘forge-fork’ for a + fork created within this account. If unspecified, then the + name of the account is used. + + Example: ‘(("tarsius") ("emacsmirror" remote-name "mirror"))’. + + -- User Option: forge-owned-ignored + This is a list of repository names that are considered to not be + owned by you even though they would have been considered to be + owned by you based on ‘forge-owned-accounts’. + + +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 N: Branching. (line 13) +* b n: Branching. (line 102) +* C-c C-c: Editing Topics and Posts. + (line 92) +* C-c C-e: Editing Topics and Posts. + (line 100) +* C-c C-e d: Editing Topics and Posts. + (line 105) +* C-c C-e [on "Assignees" section]: Editing Topics and Posts. + (line 56) +* C-c C-e [on "Draft" section]: Editing Topics and Posts. + (line 40) +* C-c C-e [on "Labels" section]: Editing Topics and Posts. + (line 43) +* C-c C-e [on "Marks" section]: Editing Topics and Posts. + (line 47) +* C-c C-e [on "Note" section]: Editing Topics and Posts. + (line 65) +* C-c C-e [on "Review-Requests" section]: Editing Topics and Posts. + (line 60) +* C-c C-e [on "State" section]: Editing Topics and Posts. + (line 36) +* C-c C-e [on "Title" section]: Editing Topics and Posts. + (line 32) +* C-c C-e [on a post section]: Editing Topics and Posts. + (line 27) +* C-c C-k: Editing Topics and Posts. + (line 96) +* C-c C-k [on a comment section]: Editing Topics and Posts. + (line 68) +* C-c C-n: Editing Topics and Posts. + (line 17) +* C-c C-n [on "Issues" section]: Creating Topics. (line 12) +* C-c C-n [on "Pull requests" section]: Creating Topics. (line 8) +* C-c C-r: Editing Topics and Posts. + (line 17) +* C-c C-v: Visiting Topics. (line 36) +* C-c C-w: Visiting Topics. (line 22) +* C-c C-w <1>: Visiting Topics. (line 22) +* f n: Pulling. (line 13) +* f N: Pulling. (line 25) +* m M [if enabled]: Editing Topics and Posts. + (line 72) +* N: Usage. (line 23) +* N a: Usage. (line 13) +* N a <1>: Miscellaneous. (line 15) +* N b I: Visiting Topics. (line 22) +* N b i: Visiting Topics. (line 22) +* N b P: Visiting Topics. (line 22) +* N b p: Visiting Topics. (line 22) +* N b r: Visiting Topics. (line 22) +* N b t: Visiting Topics. (line 22) +* N c f: Miscellaneous. (line 7) +* N c i: Creating Topics. (line 12) +* N c p: Creating Topics. (line 8) +* N f f: Pulling. (line 13) +* N f n: Pulling. (line 25) +* N f t: Pulling. (line 47) +* N l i: Listing Topics and Notifications. + (line 73) +* N l n: Listing Topics and Notifications. + (line 65) +* N l p: Listing Topics and Notifications. + (line 69) +* N l r: Listing Topics and Notifications. + (line 62) +* N M [if enabled]: Editing Topics and Posts. + (line 72) +* N r: Repository Detection. + (line 80) +* N t c: Miscellaneous. (line 28) +* N t t: Miscellaneous. (line 24) +* N v i: Visiting Topics. (line 36) +* N v p: Visiting Topics. (line 36) +* N v t: Visiting Topics. (line 36) +* RET: Visiting Topics. (line 36) +* Z n: Branching. (line 107) + + +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 50) +* forge-insert-assigned-pullreqs: Listing Topics and Notifications. + (line 38) +* forge-insert-authored-issues: Listing Topics and Notifications. + (line 54) +* forge-insert-authored-pullreqs: Listing Topics and Notifications. + (line 46) +* forge-insert-issues: Listing Topics and Notifications. + (line 17) +* forge-insert-pullreqs: Listing Topics and Notifications. + (line 13) +* forge-insert-requested-reviews: Listing Topics and Notifications. + (line 42) +* forge-list-assigned-issues: Listing Topics and Notifications. + (line 88) +* forge-list-assigned-pullreqs: Listing Topics and Notifications. + (line 84) +* forge-list-authored-issues: Listing Topics and Notifications. + (line 100) +* forge-list-authored-pullreqs: Listing Topics and Notifications. + (line 96) +* forge-list-issues: Listing Topics and Notifications. + (line 73) +* forge-list-labeled-issues: Listing Topics and Notifications. + (line 80) +* forge-list-labeled-pullreqs: Listing Topics and Notifications. + (line 76) +* forge-list-notifications: Listing Topics and Notifications. + (line 65) +* forge-list-owned-issues: Listing Topics and Notifications. + (line 110) +* forge-list-owned-pullreqs: Listing Topics and Notifications. + (line 104) +* forge-list-pullreqs: Listing Topics and Notifications. + (line 69) +* forge-list-repositories: Listing Topics and Notifications. + (line 62) +* forge-list-requested-reviews: Listing Topics and Notifications. + (line 92) +* forge-merge: Editing Topics and Posts. + (line 72) +* forge-post-cancel: Editing Topics and Posts. + (line 96) +* forge-post-dispatch: Editing Topics and Posts. + (line 100) +* forge-post-submit: Editing Topics and Posts. + (line 92) +* forge-post-toggle-draft: Editing Topics and Posts. + (line 105) +* forge-pull: Pulling. (line 13) +* forge-pull-notifications: Pulling. (line 25) +* forge-pull-topic: Pulling. (line 47) +* forge-remove-repository: Miscellaneous. (line 44) +* forge-remove-topic-locally: Miscellaneous. (line 48) +* forge-reset-database: Miscellaneous. (line 58) +* forge-toggle-closed-visibility: Listing Topics and Notifications. + (line 31) +* forge-toggle-closed-visibility <1>: Miscellaneous. (line 28) +* forge-toggle-display-in-status-buffer: Miscellaneous. (line 24) +* forge-visit-issue: Visiting Topics. (line 36) +* forge-visit-pullreq: Visiting Topics. (line 36) +* forge-visit-topic: Visiting Topics. (line 36) +* forge-visit-TYPE: Visiting Topics. (line 36) + + +File: forge.info, Node: Variable Index, Prev: Function and Command Index, Up: Top + +Appendix D Variable Index +************************* + +[index] +* Menu: + +* forge-owned-accounts: Listing Topics and Notifications. + (line 116) +* forge-owned-ignored: Listing Topics and Notifications. + (line 131) +* forge-topic-list-limit: Listing Topics and Notifications. + (line 20) +* forge.remote: Repository Detection. + (line 66) + + + +Tag Table: +Node: Top751 +Node: Introduction2435 +Node: Supported Forges and Hosts2998 +Node: Supported Forges4248 +Ref: Github4404 +Ref: Github Caveats4547 +Ref: Github Hosts5193 +Ref: Gitlab5249 +Ref: Gitlab Caveats5264 +Ref: Gitlab Hosts5389 +Node: Partially Supported Forges5509 +Ref: Gitea https//giteaio5715 +Ref: Gitea Hosts5815 +Ref: Gogs https//gogsio5871 +Ref: Gogs Hosts6074 +Ref: Bitbucket https//bitbucketorg6132 +Ref: Bitbucket Caveats6330 +Ref: Bitbucket Hosts7227 +Node: Supported Semi-Forges7292 +Ref: Gitweb https//git-scmcom/docs/gitweb7463 +Ref: Gitweb Caveats7542 +Ref: Cgit https//gitzx2c4com/cgit/about7782 +Ref: Cgit Caveats7859 +Ref: Cgit Hosts8208 +Ref: Stgit https//codemadnessorg/git/stagit/file/READMEhtml8335 +Ref: Stgit Caveats8452 +Ref: Stgit Hosts8738 +Ref: Srht https//metasrht8798 +Ref: Srht Caveats8847 +Ref: Srht Hosts9130 +Node: Getting Started9181 +Node: Loading Forge10179 +Node: Token Creation10574 +Node: Initial Pull11853 +Node: Repository Detection13248 +Node: Caveats17387 +Node: Usage18313 +Node: Pulling19785 +Node: Branching22468 +Node: Working with Topics28857 +Node: Visiting Topics29230 +Node: Listing Topics and Notifications31307 +Node: Creating Topics36631 +Node: Editing Topics and Posts37120 +Node: Miscellaneous41647 +Node: FAQ44270 +Node: Is it possible to create a single pull-request without pulling everything?44738 +Node: error in process filter HTTP Error 502 "Bad gateway"45204 +Node: Keystroke Index47575 +Node: Function and Command Index53265 +Node: Variable Index61223 + +End Tag Table + + +Local Variables: +coding: utf-8 +End: