dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

commit c4eca1cdaa6ac4061888a8827b5020910d9ec2e5
parent 441c04f33ee23379ffa6a3fc8cc641cc764dc454
Author: Lukas Henkel <lh@entf.net>
Date:   Sat, 20 May 2023 14:48:31 +0200

Remove forge

I don't actually need it

Diffstat:
Delpa/forge-0.3.2/dir | 18------------------
Delpa/forge-0.3.2/forge-autoloads.el | 343-------------------------------------------------------------------------------
Delpa/forge-0.3.2/forge-bitbucket.el | 47-----------------------------------------------
Delpa/forge-0.3.2/forge-commands.el | 1065-------------------------------------------------------------------------------
Delpa/forge-0.3.2/forge-core.el | 354-------------------------------------------------------------------------------
Delpa/forge-0.3.2/forge-db.el | 495-------------------------------------------------------------------------------
Delpa/forge-0.3.2/forge-gitea.el | 48------------------------------------------------
Delpa/forge-0.3.2/forge-github.el | 758-------------------------------------------------------------------------------
Delpa/forge-0.3.2/forge-gitlab.el | 630-------------------------------------------------------------------------------
Delpa/forge-0.3.2/forge-gogs.el | 47-----------------------------------------------
Delpa/forge-0.3.2/forge-issue.el | 225-------------------------------------------------------------------------------
Delpa/forge-0.3.2/forge-list.el | 470-------------------------------------------------------------------------------
Delpa/forge-0.3.2/forge-notify.el | 156-------------------------------------------------------------------------------
Delpa/forge-0.3.2/forge-pkg.el | 21---------------------
Delpa/forge-0.3.2/forge-post.el | 259-------------------------------------------------------------------------------
Delpa/forge-0.3.2/forge-pullreq.el | 366-------------------------------------------------------------------------------
Delpa/forge-0.3.2/forge-repo.el | 370-------------------------------------------------------------------------------
Delpa/forge-0.3.2/forge-revnote.el | 48------------------------------------------------
Delpa/forge-0.3.2/forge-semi.el | 82-------------------------------------------------------------------------------
Delpa/forge-0.3.2/forge-topic.el | 963-------------------------------------------------------------------------------
Delpa/forge-0.3.2/forge.el | 155-------------------------------------------------------------------------------
Delpa/forge-0.3.2/forge.info | 1428-------------------------------------------------------------------------------
Minit.el | 2+-
23 files changed, 1 insertion(+), 8349 deletions(-)

diff --git a/elpa/forge-0.3.2/dir b/elpa/forge-0.3.2/dir @@ -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<Return>" visits the Emacs manual, etc. - - In Emacs, you can click mouse button 2 on a menu item or cross reference - to select it. - -* Menu: - -Emacs -* Forge: (forge). Access Git Forges from Magit. diff --git a/elpa/forge-0.3.2/forge-autoloads.el b/elpa/forge-0.3.2/forge-autoloads.el @@ -1,343 +0,0 @@ -;;; forge-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- -;; Generated by the `loaddefs-generate' function. - -;; This file is part of GNU Emacs. - -;;; Code: - -(add-to-list 'load-path (or (and load-file-name (file-name-directory load-file-name)) (car load-path))) - - - -;;; Generated autoloads from forge.el - -(defvar forge-add-default-bindings t "\ -Whether to add Forge's bindings to various Magit keymaps. -If you want to disable this, then you must set this to nil before -`magit' is loaded. If you do it before `forge' but after `magit' -is loaded, then `magit-mode-map' ends up being modified anyway.") -(with-eval-after-load 'magit-mode (when forge-add-default-bindings (define-key magit-mode-map "'" 'forge-dispatch) (define-key magit-mode-map "N" 'forge-dispatch))) -(register-definition-prefixes "forge" '("forge-")) - - -;;; Generated autoloads from forge-bitbucket.el - -(register-definition-prefixes "forge-bitbucket" '("forge-bitbucket-repository")) - - -;;; Generated autoloads from forge-commands.el - - (autoload 'forge-dispatch "forge-commands" nil t) -(autoload 'forge-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) -(autoload 'forge-pull-notifications "forge-commands" "\ -Fetch notifications for all repositories from the current forge." t) -(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) -(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) -(autoload 'forge-browse-commit "forge-commands" "\ -Visit the url corresponding to REV using a browser. - -(fn REV)" t) -(autoload 'forge-copy-url-at-point-as-kill "forge-commands" "\ -Copy the url of the thing at point." t) -(autoload 'forge-browse-branch "forge-commands" "\ -Visit the url corresponding BRANCH using a browser. - -(fn BRANCH)" t) -(autoload 'forge-browse-remote "forge-commands" "\ -Visit the url corresponding to REMOTE using a browser. - -(fn REMOTE)" t) -(autoload 'forge-browse-repository "forge-commands" "\ -View the current repository in a separate buffer. - -(fn REPO)" t) -(autoload 'forge-browse-topic "forge-commands" "\ -Visit the current topic using a browser." t) -(autoload 'forge-browse-pullreqs "forge-commands" "\ -Visit the pull-requests of the current repository using a browser." t) -(autoload 'forge-browse-pullreq "forge-commands" "\ -Visit the url corresponding to PULLREQ using a browser. - -(fn PULLREQ)" t) -(autoload 'forge-browse-issues "forge-commands" "\ -Visit the issues of the current repository using a browser." t) -(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) -(autoload 'forge-browse-post "forge-commands" "\ -Visit the current post using a browser." t) -(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) -(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. - -(fn PULLREQ)" t) -(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. - -(fn ISSUE)" t) -(autoload 'forge-visit-repository "forge-commands" "\ -View the current repository in a separate buffer. - -(fn REPO)" t) -(autoload 'forge-branch-pullreq "forge-commands" "\ -Create and configure a new branch from a pull-request. -Please see the manual for more information. - -(fn PULLREQ)" t) -(autoload 'forge-checkout-pullreq "forge-commands" "\ -Create, configure and checkout a new branch from a pull-request. -Please see the manual for more information. - -(fn PULLREQ)" t) -(autoload 'forge-checkout-worktree "forge-commands" "\ -Create, configure and checkout a new worktree from a pull-request. -This is like `forge-checkout-pullreq', except that it also -creates a new worktree. Please see the manual for more -information. - -(fn PATH PULLREQ)" t) -(autoload 'forge-fork "forge-commands" "\ -Fork the current repository to FORK and add it as a REMOTE. -If the fork already exists, then that isn't an error; the remote -is added anyway. Currently this only supports Github and Gitlab. - -(fn FORK REMOTE)" t) -(autoload 'forge-list-notifications "forge-commands" "\ -List notifications." t) -(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) -(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) -(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) -(autoload 'forge-add-organization-repositories "forge-commands" "\ -Add all of ORGANIZATION's repositories from HOST to the database. -This may take a while. Only Github is supported at the moment. - -(fn HOST ORGANIZATION)" t) -(autoload 'forge-merge "forge-commands" "\ -Merge the current pull-request using METHOD using the forge's API. - -If there is no current pull-request or with a prefix argument, -then read pull-request PULLREQ to visit instead. - -Use of this command is discouraged. Unless the remote repository -is configured to disallow that, you should instead merge locally -and then push the target branch. Forges detect that you have -done that and respond by automatically marking the pull-request -as merged. - -(fn PULLREQ METHOD)" t) -(autoload 'forge-remove-repository "forge-commands" "\ -Remove a repository from the database. - -(fn HOST OWNER NAME)" t) -(autoload 'forge-remove-topic-locally "forge-commands" "\ -Remove a topic from the local database only. -Due to how the supported APIs work, it would be too expensive to -automatically remove topics from the local datbase that were -removed from the forge. The purpose of this command is to allow -you to manually clean up the local database. - -(fn TOPIC)" t) -(autoload 'forge-reset-database "forge-commands" "\ -Move the current database file to the trash. -This is useful after the database scheme has changed, which will -happen a few times while the forge functionality is still under -heavy development." t) -(register-definition-prefixes "forge-commands" '("forge-")) - - -;;; Generated autoloads from forge-core.el - -(register-definition-prefixes "forge-core" '("forge-")) - - -;;; Generated autoloads from forge-db.el - -(register-definition-prefixes "forge-db" '("forge-")) - - -;;; Generated autoloads from forge-gitea.el - -(register-definition-prefixes "forge-gitea" '("forge-gitea-repository")) - - -;;; Generated autoloads from forge-github.el - -(register-definition-prefixes "forge-github" '("forge-")) - - -;;; Generated autoloads from forge-gitlab.el - -(register-definition-prefixes "forge-gitlab" '("forge-gitlab-repository")) - - -;;; Generated autoloads from forge-gogs.el - -(register-definition-prefixes "forge-gogs" '("forge-gogs-repository")) - - -;;; Generated autoloads from forge-issue.el - -(register-definition-prefixes "forge-issue" '("forge-")) - - -;;; Generated autoloads from forge-list.el - -(autoload 'forge-list-topics "forge-list" "\ -List topics of the current repository in a separate buffer. - -(fn ID)" t) -(autoload 'forge-list-issues "forge-list" "\ -List issues of the current repository in a separate buffer. - -(fn ID)" t) -(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) -(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) -(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) -(autoload 'forge-list-pullreqs "forge-list" "\ -List pull-requests of the current repository in a separate buffer. - -(fn ID)" t) -(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) -(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) -(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) -(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) -(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) -(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) -(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) -(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) -(register-definition-prefixes "forge-list" '("forge-")) - - -;;; Generated autoloads from forge-notify.el - -(register-definition-prefixes "forge-notify" '("forge-")) - - -;;; Generated autoloads from forge-post.el - -(register-definition-prefixes "forge-post" '("forge-")) - - -;;; Generated autoloads from forge-pullreq.el - -(register-definition-prefixes "forge-pullreq" '("forge-")) - - -;;; Generated autoloads from forge-repo.el - -(register-definition-prefixes "forge-repo" '("forge-")) - - -;;; Generated autoloads from forge-revnote.el - -(register-definition-prefixes "forge-revnote" '("forge-revnote")) - - -;;; Generated autoloads from forge-semi.el - -(register-definition-prefixes "forge-semi" '("forge-")) - - -;;; Generated autoloads from forge-topic.el - -(register-definition-prefixes "forge-topic" '("forge-")) - -;;; End of scraped data - -(provide 'forge-autoloads) - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; no-native-compile: t -;; coding: utf-8-emacs-unix -;; End: - -;;; forge-autoloads.el ends here diff --git a/elpa/forge-0.3.2/forge-bitbucket.el b/elpa/forge-0.3.2/forge-bitbucket.el @@ -1,47 +0,0 @@ -;;; forge-bitbucket.el --- Bitbucket support -*- lexical-binding: t -*- - -;; Copyright (C) 2018-2022 Jonas Bernoulli - -;; Author: Jonas Bernoulli <jonas@bernoul.li> -;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This file is not part of GNU Emacs. - -;; Forge 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, or (at your option) -;; any later version. -;; -;; Forge 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 Forge. If not, see http://www.gnu.org/licenses. - -;;; Code: - -(require 'buck) -(require 'forge) - -;;; Class - -(defclass forge-bitbucket-repository (forge-noapi-repository) - ((issues-url-format :initform "https://%h/%o/%n/issues") - (issue-url-format :initform "https://%h/%o/%n/issues/%i") - ;; The anchor for the issue itself is .../%i#issue-%i - (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#comment-%I") - (pullreqs-url-format :initform "https://%h/%o/%n/pull-requests") - (pullreq-url-format :initform "https://%h/%o/%n/pull-requests/%i") - (pullreq-post-url-format :initform "https://%h/%o/%n/pull-requests/%i#comment-%I") - (commit-url-format :initform "https://%h/%o/%n/commits/%r") - (branch-url-format :initform "https://%h/%o/%n/branch/%r") - (remote-url-format :initform "https://%h/%o/%n/src") - (create-issue-url-format :initform "https://%h/%o/%n/issues/new") - (create-pullreq-url-format :initform "https://%h/%o/%n/pull-requests/new"))) - -;;; _ -(provide 'forge-bitbucket) -;;; forge-bitbucket.el ends here diff --git a/elpa/forge-0.3.2/forge-commands.el b/elpa/forge-0.3.2/forge-commands.el @@ -1,1065 +0,0 @@ -;;; forge-commands.el --- Commands -*- lexical-binding: t -*- - -;; Copyright (C) 2018-2022 Jonas Bernoulli - -;; Author: Jonas Bernoulli <jonas@bernoul.li> -;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This file is not part of GNU Emacs. - -;; Forge 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, or (at your option) -;; any later version. -;; -;; Forge 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 Forge. If not, see http://www.gnu.org/licenses. - -;;; Code: - -(require 'forge) - -;;; Options - -(defcustom forge-add-pullreq-refspec t - "Whether the pull-request refspec is added when setting up a repository. - -This controls whether running `forge-pull' for the first time in -a repository also adds a refspec that fetches all pull-requests. -In repositories with huge numbers of pull-requests you might want -to not do so, in which case you should set this option to `ask'. - -You can also set this to nil and later add the refspec explicitly -for a repository using the command `forge-add-pullreq-refspec'." - :package-version '(forge . "0.2.0") - :group 'forge - :type '(choice (const :tag "Always add refspec" t) - (const :tag "Ask every time" ask) - (const :tag "Never add refspec" nil))) - -(defcustom forge-checkout-worktree-read-directory-function - 'forge-checkout-worktree-default-read-directory-function - "Function used by `forge-checkout-worktree' to read worktree directory. -Takes the pull-request as only argument and must return a directory." - :package-version '(forge . "0.4.0") - :group 'forge - :type 'function) - -;;; Dispatch - -;;;###autoload (autoload 'forge-dispatch "forge-commands" nil t) -(transient-define-prefix forge-dispatch () - "Dispatch a forge command." - [["Fetch" - ("f f" "all topics" forge-pull) - ("f t" "one topic" forge-pull-topic) - ("f n" "notifications" forge-pull-notifications) - """Create" - ("c i" "issue" forge-create-issue) - ("c p" "pull-request" forge-create-pullreq) - ("c u" "pull-request from issue" forge-create-pullreq-from-issue - :if (lambda () (forge-github-repository-p (forge-get-repository nil)))) - ("c f" "fork or remote" forge-fork) - """Merge" - (7 "M " "merge using API" forge-merge)] - ["List" - ("l t" "topics" forge-list-topics) - ("l i" "issues" forge-list-issues) - ("l p" "pull-requests" forge-list-pullreqs) - ("l n" "notifications" forge-list-notifications) - ("l r" "repositories" forge-list-repositories) - (7 "l a" "awaiting review" forge-list-requested-reviews) - (7 "n i" "labeled issues" forge-list-labeled-issues) - (7 "n p" "labeled pull-requests" forge-list-labeled-pullreqs) - (7 "m i" "authored issues" forge-list-authored-issues) - (7 "m p" "authored pull-requests" forge-list-authored-pullreqs) - (7 "o i" "owned issues" forge-list-owned-issues) - (7 "o p" "owned pull-requests" forge-list-owned-pullreqs) - (7 "o r" "owned repositories" forge-list-owned-repositories)] - ["Visit" - ("v t" "topic" forge-visit-topic) - ("v i" "issue" forge-visit-issue) - ("v p" "pull-request" forge-visit-pullreq) - """Browse" - ("b I" "issues" forge-browse-issues) - ("b P" "pull-requests" forge-browse-pullreqs) - ("b t" "topic" forge-browse-topic) - ("b i" "issue" forge-browse-issue) - ("b p" "pull-request" forge-browse-pullreq)]] - [["Configure" - ("a " "add repository to database" forge-add-repository) - ("r " "forge.remote" forge-forge.remote) - ("t t" forge-toggle-display-in-status-buffer) - ("t c" forge-toggle-closed-visibility)]]) - -;;; Pull - -;;;###autoload -(defun forge-pull (&optional repo until) - "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'." - (interactive - (list nil - (and current-prefix-arg - (not (forge-get-repository 'full)) - (forge-read-date "Limit pulling to topics updates since: ")))) - (let (create) - (unless repo - (setq repo (forge-get-repository 'full)) - (unless repo - (setq repo (forge-get-repository 'create)) - (setq create t))) - (when (or create - (called-interactively-p 'any) - (magit-git-config-p "forge.autoPull" t)) - (forge--zap-repository-cache repo) - (when (and (oref repo selective-p) - (called-interactively-p 'any) - (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." - (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." - (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)) - (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 (when-let ((d (magit-branch-at-point))) - (if (magit-remote-branch-p d) - d - (magit-get-push-branch d t))) - (when-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-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 - (if (and (forge--childp topic 'forge-pullreq) - (forge--childp repo 'forge-gitlab-repository)) - (list ; Gitlab merge-requests can only be assigned to a single user. - (magit-completing-read - "Assignee" choices nil - nil ; Empty input removes assignee. - (car value))) - (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)))) - -(cl-defmethod forge--branch-pullreq ((_repo forge-unusedapi-repository) - (pullreq forge-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") - (magit-refresh) - branch)) - -(cl-defmethod forge--branch-pullreq ((repo forge-repository) - (pullreq forge-pullreq)) - (with-slots (number title editable-p cross-repo-p state - base-ref base-repo - head-ref head-repo head-user) - pullreq - (let* ((host (oref repo githost)) - (upstream (oref repo remote)) - (upstream-url (magit-git-string "remote" "get-url" upstream)) - (remote head-user) - (branch (forge--pullreq-branch-select pullreq)) - (pr-branch head-ref)) - (when (string-match-p ":" 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. - (error "Cannot check out this Gitlab merge-request \ -because the source branch has been deleted")) - (if (not (eq state 'open)) - (magit-git "branch" "--force" branch - (format "refs/pullreqs/%s" number)) - (if (not cross-repo-p) - (let ((tracking (concat upstream "/" pr-branch))) - (unless (magit-branch-p tracking) - (magit-call-git "fetch" upstream)) - (magit-call-git "branch" branch tracking) - (magit-branch-maybe-adjust-upstream branch tracking) - (magit-set upstream "branch" branch "pushRemote") - (magit-set upstream "branch" branch "pullRequestRemote")) - (if (magit-remote-p remote) - (let ((url (magit-git-string "remote" "get-url" remote)) - (fetch (magit-get-all "remote" remote "fetch"))) - (unless (forge--url-equal - url (format "git@%s:%s.git" host head-repo)) - (user-error - "Remote `%s' already exists but does not point to %s" - remote url)) - (unless (or (member (format "+refs/heads/*:refs/remotes/%s/*" - remote) - fetch) - (member (format "+refs/heads/%s:refs/remotes/%s/%s" - pr-branch remote pr-branch) - fetch)) - (magit-git "remote" "set-branches" "--add" remote pr-branch) - (magit-git "fetch" remote))) - (magit-git - "remote" "add" "-f" "--no-tags" - "-t" pr-branch remote - (cond ((or (string-prefix-p "git@" upstream-url) - (string-prefix-p "ssh://git@" upstream-url)) - (format "git@%s:%s.git" host head-repo)) - ((string-prefix-p "https://" upstream-url) - (format "https://%s/%s.git" host head-repo)) - ((string-prefix-p "git://" upstream-url) - (format "git://%s/%s.git" host head-repo)) - ((string-prefix-p "http://" upstream-url) - (format "http://%s/%s.git" host head-repo)) - (t (error "%s has an unexpected format" upstream-url))))) - (magit-git "branch" "--force" branch (concat remote "/" pr-branch)) - (if (and editable-p - (equal branch pr-branch)) - (magit-set remote "branch" branch "pushRemote") - (magit-set upstream "branch" branch "pushRemote"))) - (magit-set remote "branch" branch "pullRequestRemote") - (magit-set "true" "branch" branch "rebase") - (magit-git "branch" branch - (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 title "branch" branch "description") - (magit-refresh) - branch))) - -;;;###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))) - (let ((pullreq (forge-get-pullreq pullreq))) - (magit-checkout - (or (if (not (eq (oref pullreq state) 'open)) - (magit-ref-p (format "refs/pullreqs/%s" - (oref pullreq number))) - (forge--pullreq-branch-active pullreq)) - (let ((magit-inhibit-refresh t)) - (forge-branch-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 "/tmp/testing/")) 2)))) - (user-error "%s already exists and isn't empty" path)) - (magit-worktree-checkout path - (let ((magit-inhibit-refresh t)) - (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 - (replace-regexp-in-string "/" "-" 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 "origin") - -;;;###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)) - -;;;###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)" - (when-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 datbase 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-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 forge--db-connection - (emacsql-close forge--db-connection)) - (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 db)))) - -(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-0.3.2/forge-core.el b/elpa/forge-0.3.2/forge-core.el @@ -1,354 +0,0 @@ -;;; forge-core.el --- Core functionality -*- lexical-binding: t -*- - -;; Copyright (C) 2018-2022 Jonas Bernoulli - -;; Author: Jonas Bernoulli <jonas@bernoul.li> -;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This file is not part of GNU Emacs. - -;; Forge 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, or (at your option) -;; any later version. -;; -;; Forge 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 Forge. If not, see http://www.gnu.org/licenses. - -;;; Code: - -(require 'magit) - -(require 'cl-lib) -(require 'dash) -(require 'eieio) -(require 'subr-x) - -(require 'transient) - -(require 'forge-db) - -(eval-when-compile - (cl-pushnew 'id eieio--known-slot-names) - (cl-pushnew 'name eieio--known-slot-names) - (cl-pushnew 'owner eieio--known-slot-names) - (cl-pushnew 'number eieio--known-slot-names)) - -;;; Options - -(defgroup forge nil - "Options concerning Git forges." - :group 'magit) - -(defgroup forge-faces nil - "Faces concerning Git forges." - :group 'forge - :group 'magit-faces) - -(defcustom forge-alist - '(;; Forges - ("github.com" "api.github.com" - "github.com" forge-github-repository) - ("gitlab.com" "gitlab.com/api/v4" - "gitlab.com" forge-gitlab-repository) - ("salsa.debian.org" "salsa.debian.org/api/v4" - "salsa.debian.org" forge-gitlab-repository) - ("framagit.org" "framagit.org/api/v4" - "framagit.org" forge-gitlab-repository) - ("gitlab.gnome.org" "gitlab.gnome.org/api/v4" - "gitlab.gnome.org" forge-gitlab-repository) - ;; Forges (API unsupported) - ("codeberg.org" "codeberg.org/api/v1" - "codeberg.org" forge-gitea-repository) - ("code.orgmode.org" "code.orgmode.org/api/v1" - "code.orgmode.org" forge-gogs-repository) - ("bitbucket.org" "api.bitbucket.org/2.0" - "bitbucket.org" forge-bitbucket-repository) - ;; Semi-Forges - ("git.savannah.gnu.org" nil - "git.savannah.gnu.org" forge-cgit**-repository) - ("git.kernel.org" nil - "git.kernel.org" forge-cgit-repository) - ("repo.or.cz" nil - "repo.or.cz" forge-repoorcz-repository) - ("git.suckless.org" nil - "git.suckless.org" forge-stagit-repository) - ("git.sr.ht" nil - "git.sr.ht" forge-srht-repository)) - "List of Git forges. - -Each entry has the form (GITHOST APIHOST ID CLASS). - -GITHOST is matched against the host part of Git remote urls - using `forge--url-regexp' to identify the forge. -APIHOST is the api endpoint of the forge's api. -ID is used to identify the forge in the local database. -CLASS is the class to be used for repository from the forge. - -GITHOST and APIHOST can be changed, but ID and CLASS are final. -If you change ID, then the identity of every repository from -that forge changes. If you change CLASS, then things start -falling apart. - -There can be multiple elements that only differ in GITHOST. -Among those, the canonical element should come first. Any -elements that have the same APIHOST must also have the same -ID, and vice-versa. - -Complications: - -* When connecting to a Github Enterprise edition whose REST - API's end point is \"<host>/v3\" and whose GraphQL API's - end point is \"<host>/graphql\", then use \"<host>/v3\" as - APIHOST. This is a historic accident. See issue #174." - :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.") - -(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 . ,(replace-regexp-in-string "/" "%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) - (when-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) - (when-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) - (when-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 (when-let - ((v (ignore-errors - (cl-case slot - (repo (oref object name)) - (project (concat (replace-regexp-in-string - "/" "%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-0.3.2/forge-db.el b/elpa/forge-0.3.2/forge-db.el @@ -1,495 +0,0 @@ -;;; forge-db.el --- Database implementation -*- lexical-binding: t -*- - -;; Copyright (C) 2018-2022 Jonas Bernoulli - -;; Author: Jonas Bernoulli <jonas@bernoul.li> -;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This file is not part of GNU Emacs. - -;; Forge 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, or (at your option) -;; any later version. -;; -;; Forge 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 Forge. If not, see http://www.gnu.org/licenses. - -;;; Code: - -(require 'closql) -(require 'eieio) -(require 'emacsql) -(require 'emacsql-sqlite) - -(defvar forge--db-table-schemata) - -;; For `forge--db-maybe-update': -(declare-function forge-get-issue "forge-core") -(declare-function forge-get-pullreq "forge-core") -(declare-function forge--object-id "forge-core") - -;;; Options - -(defcustom forge-database-connector 'sqlite - "The database connector used by Forge. - -This must be set before `forge' is loaded. To use an alternative -connector you must install the respective package explicitly. - -When `sqlite', then use the `emacsql-sqlite' library that is -being maintained in the same repository as `emacsql' itself. - -When `sqlite-builtin', then use the builtin support in Emacs 29. -When `sqlite-module', then use a module provided by the `sqlite3' -package. These two backends are experimental. -See https://github.com/skeeto/emacsql/pull/86. - -When `libsqlite3', then use the `emacsql-libsqlite' library, -which itself uses a module provided by the `sqlite3' package. -This is still experimental and likely to be deprecated in -favor of `sqlite-module'. - -When `sqlite3', then use the `emacsql-sqlite3' library, which -uses the official `sqlite3' command-line tool, which I do not -recommended because it is not suitable to be used like this, -but has the advantage that you likely don't need a compiler. -See https://nullprogram.com/blog/2014/02/06/." - :package-version '(forge . "0.3.0") - :group 'forge - :type '(choice (const sqlite) - (const sqlite-builtin) - (const sqlite-module) - (const libsqlite3) - (const sqlite3) - (symbol :tag "other"))) - -(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 - -(declare-function forge-database--eieio-childp "forge-db.el" (obj) t) -(cl-ecase forge-database-connector - (sqlite - (defclass forge-database (emacsql-sqlite-connection closql-database) - ((object-class :initform 'forge-repository)))) - (sqlite-builtin - (require (quote emacsql-sqlite-builtin)) - (with-no-warnings - (defclass forge-database (emacsql-sqlite-builtin-connection closql-database) - ((object-class :initform 'epkg-package))))) - (sqlite-module - (require (quote emacsql-sqlite-module)) - (with-no-warnings - (defclass forge-database (emacsql-sqlite-module-connection closql-database) - ((object-class :initform 'epkg-package))))) - (libsqlite3 - (require (quote emacsql-libsqlite3)) - (with-no-warnings - (defclass forge-database (emacsql-libsqlite3-connection closql-database) - ((object-class :initform 'forge-repository))))) - (sqlite3 - (require (quote emacsql-sqlite3)) - (with-no-warnings - (defclass forge-database (emacsql-sqlite3-connection closql-database) - ((object-class :initform 'forge-repository)))))) - -(defconst forge--db-version 7) -(defconst forge--sqlite-available-p - (with-demoted-errors "Forge initialization: %S" - (emacsql-sqlite-ensure-binary) - t)) - -(defvar forge--db-connection nil - "The EmacSQL database connection.") - -(defun forge-db () - (unless (and forge--db-connection (emacsql-live-p forge--db-connection)) - (make-directory (file-name-directory forge-database-file) t) - (closql-db 'forge-database 'forge--db-connection - forge-database-file t) - (let* ((db forge--db-connection) - (version (closql--db-get-version db)) - (version (forge--db-maybe-update forge--db-connection version))) - (cond - ((> version forge--db-version) - (emacsql-close db) - (user-error - "The Forge database was created with a newer Forge version. %s" - "You need to update the Forge package.")) - ((< version forge--db-version) - (emacsql-close db) - (error "BUG: The Forge database scheme changed %s" - "and there is no upgrade path"))))) - forge--db-connection) - -;;; Api - -(defun forge-sql (sql &rest args) - (if (stringp sql) - (emacsql (forge-db) (apply #'format sql args)) - (apply #'emacsql (forge-db) sql args))) - -;;; 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] - (: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] - (: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-init ((db forge-database)) - (emacsql-with-transaction db - (pcase-dolist (`(,table . ,schema) forge--db-table-schemata) - (emacsql db [:create-table $i1 $S2] table schema)) - (closql--db-set-version db forge--db-version))) - -(defun forge--db-maybe-update (db version) - (emacsql-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")) - ;; Going forward create a backup before upgrading: - ;; (message "Upgrading Forge database from version 7 to 8...") - ;; (copy-file forge-database-file (concat forge-database-file "-v7")) - version)) - -;;; _ -(provide 'forge-db) -;;; forge-db.el ends here diff --git a/elpa/forge-0.3.2/forge-gitea.el b/elpa/forge-0.3.2/forge-gitea.el @@ -1,48 +0,0 @@ -;;; forge-gitea.el --- Gitea support -*- lexical-binding: t -*- - -;; Copyright (C) 2018-2022 Jonas Bernoulli - -;; Author: Jonas Bernoulli <jonas@bernoul.li> -;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This file is not part of GNU Emacs. - -;; Forge 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, or (at your option) -;; any later version. -;; -;; Forge 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 Forge. If not, see http://www.gnu.org/licenses. - -;;; Code: - -(require 'gtea) -(require 'forge) - -;;; Class - -(defclass forge-gitea-repository (forge-unusedapi-repository) - ((issues-url-format :initform "https://%h/%o/%n/issues") - (issue-url-format :initform "https://%h/%o/%n/issues/%i") - ;; The anchor for the issue itself is .../%i#issue-%i - (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#issuecomment-%I") - (pullreqs-url-format :initform "https://%h/%o/%n/pulls") - (pullreq-url-format :initform "https://%h/%o/%n/pulls/%i") - (pullreq-post-url-format :initform "https://%h/%o/%n/pulls/%i#issuecomment-%I") - (commit-url-format :initform "https://%h/%o/%n/commit/%r") - (branch-url-format :initform "https://%h/%o/%n/commits/branch/%r") - (remote-url-format :initform "https://%h/%o/%n") - (create-issue-url-format :initform "https://%h/%o/%n/issues/new") - (create-pullreq-url-format :initform "https://%h/%o/%n/pulls") ; sic - (pullreq-refspec :initform "+refs/pull/*/head:refs/pullreqs/*"))) - -;;; _ -(provide 'forge-gitea) -;;; forge-gitea.el ends here diff --git a/elpa/forge-0.3.2/forge-github.el b/elpa/forge-0.3.2/forge-github.el @@ -1,758 +0,0 @@ -;;; forge-github.el --- Github support -*- lexical-binding: t -*- - -;; Copyright (C) 2018-2022 Jonas Bernoulli - -;; Author: Jonas Bernoulli <jonas@bernoul.li> -;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This file is not part of GNU Emacs. - -;; Forge 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, or (at your option) -;; any later version. -;; -;; Forge 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 Forge. If not, see http://www.gnu.org/licenses. - -;;; Code: - -(require 'ghub) - -(require 'forge) -(require 'forge-issue) -(require 'forge-pullreq) - -;;; Class - -(defclass forge-github-repository (forge-repository) - ((issues-url-format :initform "https://%h/%o/%n/issues") - (issue-url-format :initform "https://%h/%o/%n/issues/%i") - (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#issuecomment-%I") - (pullreqs-url-format :initform "https://%h/%o/%n/pulls") - (pullreq-url-format :initform "https://%h/%o/%n/pull/%i") - (pullreq-post-url-format :initform "https://%h/%o/%n/pull/%i#issuecomment-%I") - (commit-url-format :initform "https://%h/%o/%n/commit/%r") - (branch-url-format :initform "https://%h/%o/%n/commits/%r") - (remote-url-format :initform "https://%h/%o/%n") - (create-issue-url-format :initform "https://%h/%o/%n/issues/new") - (create-pullreq-url-format :initform "https://%h/%o/%n/compare") - (pullreq-refspec :initform "+refs/pull/*/head:refs/pullreqs/*"))) - -;;; Pull -;;;; Repository - -(cl-defmethod forge--pull ((repo forge-github-repository) until - &optional callback) - (let ((buf (current-buffer)) - (dir default-directory) - (selective-p (oref repo selective-p))) - (ghub-fetch-repository - (oref repo owner) - (oref repo name) - (lambda (data) - (forge--msg repo t t "Pulling REPO") - (forge--msg repo t nil "Storing REPO") - (emacsql-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) - (emacsql-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) - (emacsql-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 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) - (emacsql-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) - (emacsql-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 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 locked-p .locked) - (oset pullreq editable-p .maintainerCanModify) - (oset pullreq cross-repo-p .isCrossRepository) - (oset pullreq base-ref .baseRef.name) - (oset pullreq base-repo .baseRef.repository.nameWithOwner) - (oset pullreq head-ref .headRef.name) - (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) - (emacsql-with-transaction (forge-db) - (mapc (apply-partially 'forge--update-revnote repo) data))) - -(cl-defmethod forge--update-revnote ((repo forge-github-repository) data) - (emacsql-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 . "true")) - :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") - (emacsql-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 "_" (replace-regexp-in-string - "=" "_" 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) - (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 . ,(and (member .draft '("t" "true" "yes")) - t)) - (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-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--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--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--topic-templates ((repo forge-github-repository) - (_ (subclass forge-issue))) - (when-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))) - (when-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--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-0.3.2/forge-gitlab.el b/elpa/forge-0.3.2/forge-gitlab.el @@ -1,630 +0,0 @@ -;;; forge-gitlab.el --- Gitlab support -*- lexical-binding: t -*- - -;; Copyright (C) 2018-2022 Jonas Bernoulli - -;; Author: Jonas Bernoulli <jonas@bernoul.li> -;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This file is not part of GNU Emacs. - -;; Forge 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, or (at your option) -;; any later version. -;; -;; Forge 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 Forge. If not, see http://www.gnu.org/licenses. - -;;; Code: - -(require 'glab) - -(require 'forge) -(require 'forge-issue) -(require 'forge-pullreq) - -;;; Class - -(defclass forge-gitlab-repository (forge-repository) - ((issues-url-format :initform "https://%h/%o/%n/issues") - (issue-url-format :initform "https://%h/%o/%n/issues/%i") - (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#note_%I") - (pullreqs-url-format :initform "https://%h/%o/%n/merge_requests") - (pullreq-url-format :initform "https://%h/%o/%n/merge_requests/%i") - (pullreq-post-url-format :initform "https://%h/%o/%n/merge_requests/%i#note_%I") - (commit-url-format :initform "https://%h/%o/%n/commit/%r") - (branch-url-format :initform "https://%h/%o/%n/commits/%r") - (remote-url-format :initform "https://%h/%o/%n") - (create-issue-url-format :initform "https://%h/%o/%n/issues/new") - (create-pullreq-url-format :initform "https://%h/%o/%n/merge_requests/new") - (pullreq-refspec :initform "+refs/merge-requests/*/head:refs/pullreqs/*"))) - -;;; Pull -;;;; Repository - -(cl-defmethod forge--pull ((repo forge-gitlab-repository) until) - (let ((cb (let ((buf (and (derived-mode-p 'magit-mode) - (current-buffer))) - (dir default-directory) - (val nil)) - (lambda (cb &optional v) - (when v (if val (push v val) (setq val v))) - (let-alist val - (cond - ((not val) - (forge--fetch-repository repo cb)) - ((not (assq 'assignees val)) - (forge--fetch-assignees repo cb)) - ((not (assq 'forks val)) - (forge--fetch-forks repo cb)) - ((not (assq 'labels val)) - (forge--fetch-labels repo cb)) - ((and .issues_enabled - (not (assq 'issues val))) - (forge--fetch-issues repo cb until)) - ((and .merge_requests_enabled - (not (assq 'pullreqs val))) - (forge--fetch-pullreqs repo cb until)) - (t - (forge--msg repo t t "Pulling REPO") - (forge--msg repo t nil "Storing REPO") - (emacsql-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") - (updated_after . ,(forge--topics-until repo until 'issue))) - :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) - (emacsql-with-transaction (forge-db) - (let-alist data - (let* ((issue-id (forge--object-id 'forge-issue repo .iid)) - (issue - (forge-issue - :id issue-id - :repository (oref repo id) - :number .iid - :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") - (updated_after . ,(forge--topics-until repo until 'pullreq))) - :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 'source_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) - (emacsql-with-transaction (forge-db) - (let-alist data - (let* ((pullreq-id (forge--object-id 'forge-pullreq repo .iid)) - (pullreq - (forge-pullreq - :id pullreq-id - :repository (oref repo id) - :number .iid - :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)) - :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-repo .target_project.path_with_namespace - :head-ref .source_branch - :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 (list .assignee)) - (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 . "true")) - :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" - `(,@(and (not (equal head-remote base-remote)) - `((target_project_id . ,(oref base-repo forge-id)))) - (target_branch . ,base-branch) - (source_branch . ,head-branch) - (title . , .title) - (description . , .body) - (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-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 - (caddr (assoc (car assignees) users)))) - (forge-issue - (forge--set-topic-field repo topic 'assignee_ids - (--map (caddr (assoc it users)) assignees)))))) - -(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 . ,(if (eq method 'squash) "true" "false")) - ,@(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-0.3.2/forge-gogs.el b/elpa/forge-0.3.2/forge-gogs.el @@ -1,47 +0,0 @@ -;;; forge-gogs.el --- Gogs support -*- lexical-binding: t -*- - -;; Copyright (C) 2018-2022 Jonas Bernoulli - -;; Author: Jonas Bernoulli <jonas@bernoul.li> -;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This file is not part of GNU Emacs. - -;; Forge 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, or (at your option) -;; any later version. -;; -;; Forge 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 Forge. If not, see http://www.gnu.org/licenses. - -;;; Code: - -(require 'gogs) -(require 'forge) - -;;; Class - -(defclass forge-gogs-repository (forge-unusedapi-repository) - ((issues-url-format :initform "https://%h/%o/%n/issues") - (issue-url-format :initform "https://%h/%o/%n/issues/%i") - (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#issuecomment-%I") - (pullreqs-url-format :initform "https://%h/%o/%n/pulls") - (pullreq-url-format :initform "https://%h/%o/%n/pulls/%i") - (pullreq-post-url-format :initform "https://%h/%o/%n/pulls/%i#issuecomment-%I") - (commit-url-format :initform "https://%h/%o/%n/commit/%r") - (branch-url-format :initform "https://%h/%o/%n/commits/%r") - (remote-url-format :initform "https://%h/%o/%n") - (create-issue-url-format :initform "https://%h/%o/%n/issues/new") - (create-pullreq-url-format :initform "https://%h/%o/%n/pulls") ; sic - (pullreq-refspec :initform "+refs/pull/*/head:refs/pullreqs/*"))) - -;;; _ -(provide 'forge-gogs) -;;; forge-gogs.el ends here diff --git a/elpa/forge-0.3.2/forge-issue.el b/elpa/forge-0.3.2/forge-issue.el @@ -1,225 +0,0 @@ -;;; forge-issue.el --- Issue support -*- lexical-binding: t -*- - -;; Copyright (C) 2018-2022 Jonas Bernoulli - -;; Author: Jonas Bernoulli <jonas@bernoul.li> -;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This file is not part of GNU Emacs. - -;; Forge 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, or (at your option) -;; any later version. -;; -;; Forge 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 Forge. If not, see http://www.gnu.org/licenses. - -;;; Code: - -(require 'forge) -(require 'forge-post) -(require 'forge-topic) - -;;; Classes - -(defclass forge-issue (forge-topic) - ((closql-table :initform 'issue) - (closql-primary-key :initform 'id) - (closql-order-by :initform [(desc number)]) - (closql-foreign-key :initform 'repository) - (closql-class-prefix :initform "forge-") - (id :initarg :id) - (repository :initarg :repository) - (number :initarg :number) - (state :initarg :state) - (author :initarg :author) - (title :initarg :title) - (created :initarg :created) - (updated :initarg :updated) - (closed :initarg :closed) - (unread-p :initarg :unread-p :initform nil) - (locked-p :initarg :locked-p) - (milestone :initarg :milestone) - (body :initarg :body) - (assignees :closql-table (issue-assignee assignee)) - (project-cards) ; projectsCards - (edits) ; userContentEdits - (labels :closql-table (issue-label label)) - (participants) - (posts :closql-class forge-issue-post) - (reactions) - (timeline) - (marks :closql-table (issue-mark mark)) - (note :initarg :note :initform nil) - )) - -(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)) - (when-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)) - -;;; 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) - (when-let ((post (magit-section-value-if 'post))) - (cond ((forge-issue-p post) - post) - ((forge-issue-post-p post) - (forge-get-issue post)))))) - -(defvar forge-issues-section-map - (let ((map (make-sparse-keymap))) - (define-key map [remap magit-browse-thing] 'forge-browse-issues) - (define-key map [remap magit-visit-thing] 'forge-list-issues) - (define-key map (kbd "C-c C-n") 'forge-create-issue) - map)) - -(defvar forge-issue-section-map - (let ((map (make-sparse-keymap))) - (define-key map [remap magit-browse-thing] 'forge-browse-issue) - (define-key map [remap magit-visit-thing] 'forge-visit-issue) - map)) - -(defun forge-insert-issues () - "Insert a list of mostly recent and/or open issues. -Also see option `forge-topic-list-limit'." - (when forge-display-in-status-buffer - (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-0.3.2/forge-list.el b/elpa/forge-0.3.2/forge-list.el @@ -1,470 +0,0 @@ -;;; forge-list.el --- Tabulated-list interface -*- lexical-binding: t -*- - -;; Copyright (C) 2018-2022 Jonas Bernoulli - -;; Author: Jonas Bernoulli <jonas@bernoul.li> -;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This file is not part of GNU Emacs. - -;; Forge 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, or (at your option) -;; any later version. -;; -;; Forge 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 Forge. If not, see http://www.gnu.org/licenses. - -;;; Code: - -(require 'forge) - -(defvar x-stretch-cursor) - -;;; Options - -(defcustom forge-topic-list-mode-hook '(hl-line-mode) - "Hook run after entering Forge-Topic-List mode." - :package-version '(forge . "0.1.0") - :group 'forge - :type 'hook - :options '(hl-line-mode)) - -(defvar forge-topic-list-columns - '(("#" 5 forge-topic-list-sort-by-number (:right-align t) number nil) - ("Title" 35 t nil title nil) - )) - -(defvar forge-global-topic-list-columns - '(("Owner" 15 t nil repository:owner nil) - ("Name" 20 t nil repository:name nil) - ("#" 5 forge-topic-list-sort-by-number (:right-align t) number nil) - ("Title" 35 t nil title nil) - )) - -(defvar forge-repository-list-columns - '(("Owner" 20 t nil owner nil) - ("Name" 20 t nil name nil) - ("N" 1 t nil sparse-p nil) - ("S" 1 t nil selective-p nil) - ("Worktree" 99 t nil worktree nil) - )) - -(defcustom forge-owned-accounts nil - "An alist of accounts that are owned by you. -This should include your username as well as any organization -that you own. Used by the commands `forge-list-owned-issues', -`forge-list-owned-pullreqs' and `forge-fork'. - -Each element has the form (ACCOUNT . PLIST). The following -properties are currently being used: - -`remote-name' The default name suggested by `forge-fork' for a - fork created within this account. If unspecified, then the - name of the account is used." - :package-version '(forge . "0.2.0") - :group 'forge - :type '(repeat (cons (string :tag "Account") plist))) - -(define-obsolete-variable-alias 'forge-owned-blacklist - 'forge-owned-ignored "Forge 3.0.0") - -(defcustom forge-owned-ignored nil - "A list of repositories that are ignored when listing those owned by you. -This is a list of package names. Used by the commands -`forge-list-owned-issues' and `forge-list-owned-pullreqs'." - :package-version '(forge . "0.2.0") - :group 'forge - :type '(repeat (string :tag "Name"))) - -;;; Variables - -(defvar-local forge--tabulated-list-columns nil) -(put 'forge--tabulated-list-columns 'permanent-local t) - -(defvar-local forge--tabulated-list-query nil) -(put 'forge--tabulated-list-query 'permanent-local t) - -;;; Modes -;;;; Topics - -(defvar forge-topic-list-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map tabulated-list-mode-map) - (define-key map (kbd "RET") 'forge-visit-topic) - (define-key map [return] 'forge-visit-topic) - (define-key map (kbd "o") 'forge-browse-topic) - (define-key map (kbd "'") 'forge-dispatch) - (define-key map (kbd "?") 'magit-dispatch) - map) - "Local keymap for Forge-Topic-List mode buffers.") - -(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 forge-repository-list-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map tabulated-list-mode-map) - (define-key map (kbd "RET") 'forge-visit-repository) - (define-key map [return] 'forge-visit-repository) - (define-key map (kbd "o") 'forge-browse-repository) - (define-key map (kbd "'") 'forge-dispatch) - (define-key map (kbd "?") 'magit-dispatch) - map) - "Local keymap for Forge-Repository-List mode buffers.") - -(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-match-p ":" 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-0.3.2/forge-notify.el b/elpa/forge-0.3.2/forge-notify.el @@ -1,156 +0,0 @@ -;;; forge-notify.el --- Notify support -*- lexical-binding: t -*- - -;; Copyright (C) 2018-2022 Jonas Bernoulli - -;; Author: Jonas Bernoulli <jonas@bernoul.li> -;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This file is not part of GNU Emacs. - -;; Forge 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, or (at your option) -;; any later version. -;; -;; Forge 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 Forge. If not, see http://www.gnu.org/licenses. - -;;; Code: - -(require 'forge) - -;;; Class - -(defclass forge-notification (forge-object) - ((closql-class-prefix :initform "forge-") - (closql-table :initform 'notification) - (closql-primary-key :initform 'id) - (closql-order-by :initform [(desc id)]) - (id :initarg :id) - (thread-id :initarg :thread-id) - (repository :initarg :repository) - (forge :initarg :forge) - (reason :initarg :reason) - (unread-p :initarg :unread-p) - (last-read :initarg :last-read) - (updated :initarg :updated) - (title :initarg :title) - (type :initarg :type) - (topic :initarg :topic) - (url :initarg :url))) - -;;; Core - -(cl-defmethod forge-get-repository ((notify forge-notification)) - "Return the object for the repository that NOTIFY belongs to." - (when-let ((id (oref notify repository))) - (closql-get (forge-db) id 'forge-repository))) - -(cl-defmethod forge-get-notification ((topic forge-topic)) - (when-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 forge-notifications-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map magit-mode-map) - map) - "Keymap for `forge-notifications-mode'.") - -(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 forge-forge-repo-section-map - (let ((map (make-sparse-keymap))) - (define-key map [remap magit-browse-thing] 'forge-browse-repository) - (define-key map [remap magit-visit-thing] 'forge-visit-repository) - map)) - -(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-0.3.2/forge-pkg.el b/elpa/forge-0.3.2/forge-pkg.el @@ -1,21 +0,0 @@ -(define-package "forge" "0.3.2" "Access Git forges from Magit." - '((emacs "25.1") - (closql "1.2.0") - (dash "2.19.1") - (emacsql-sqlite "3.0.0") - (ghub "3.5.4") - (let-alist "1.0.6") - (magit "3.3.0") - (markdown-mode "2.4") - (transient "0.3.6") - (yaml "0.3.4")) - :commit "ecedeaf641f3c06ac72db57837d15bdb02ac198b" :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-0.3.2/forge-post.el b/elpa/forge-0.3.2/forge-post.el @@ -1,259 +0,0 @@ -;;; forge-post.el --- Post support -*- lexical-binding: t -*- - -;; Copyright (C) 2018-2022 Jonas Bernoulli - -;; Author: Jonas Bernoulli <jonas@bernoul.li> -;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This file is not part of GNU Emacs. - -;; Forge 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, or (at your option) -;; any later version. -;; -;; Forge 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 Forge. If not, see http://www.gnu.org/licenses. - -;;; Code: - -(require 'markdown-mode) - -(require 'forge) - -;;; Options - -(defcustom forge-post-mode-hook - '(visual-line-mode - turn-on-flyspell) - "Hook run after entering Forge-Post mode." - :package-version '(forge . "0.2.0") - :group 'forge - :type 'hook - :options '(visual-line-mode - turn-on-flyspell)) - -;;; 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)) - (when-let ((branch (magit-branch-at-point))) - (when-let ((n (magit-get "branch" branch "pullRequest"))) - (forge-get-pullreq (string-to-number n)))) - (when-let ((rev (magit-commit-at-point))) - (forge--pullreq-from-rev rev)))) - -(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) - (when-let ((repo (forge-get-repository nil)) - (refspec (oref repo pullreq-refspec)) - (name (magit-rev-name rev (cadr (split-string refspec ":"))))) - (save-match-data - (when (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 forge-post-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-c") 'forge-post-submit) - (define-key map [remap evil-save-and-close] 'forge-post-submit) - (define-key map [remap evil-save-modified-and-close] 'forge-post-submit) - (define-key map (kbd "C-c C-k") 'forge-post-cancel) - (define-key map [remap kill-buffer] 'forge-post-cancel) - (define-key map [remap ido-kill-buffer] 'forge-post-cancel) - (define-key map [remap iswitchb-kill-buffer] 'forge-post-cancel) - (define-key map [remap evil-quit] 'forge-post-cancel) - map)) - -(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) - -(defun forge--prepare-post-buffer (filename &optional header source target) - (let ((file (magit-git-dir - (convert-standard-filename - (concat "magit/posts/" filename))))) - (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)) - (re-search-forward "^title: ")) - (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))) - -;;; Notes - -(defclass forge-note (forge-post) ()) - -(defvar forge-note-section-map - (let ((map (make-sparse-keymap))) - (define-key map [remap magit-edit-thing] 'forge-edit-topic-note) - map)) - -(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-0.3.2/forge-pullreq.el b/elpa/forge-0.3.2/forge-pullreq.el @@ -1,366 +0,0 @@ -;;; forge-pullreq.el --- Pullreq support -*- lexical-binding: t -*- - -;; Copyright (C) 2018-2022 Jonas Bernoulli - -;; Author: Jonas Bernoulli <jonas@bernoul.li> -;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This file is not part of GNU Emacs. - -;; Forge 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, or (at your option) -;; any later version. -;; -;; Forge 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 Forge. If not, see http://www.gnu.org/licenses. - -;;; Code: - -(require 'forge) -(require 'forge-post) -(require 'forge-topic) - -;;; Classes - -(defclass forge-pullreq (forge-topic) - ((closql-table :initform 'pullreq) - (closql-primary-key :initform 'id) - (closql-order-by :initform [(desc number)]) - (closql-foreign-key :initform 'repository) - (closql-class-prefix :initform "forge-") - (id :initarg :id) - (repository :initarg :repository) - (number :initarg :number) - (state :initarg :state) - (author :initarg :author) - (title :initarg :title) - (created :initarg :created) - (updated :initarg :updated) - (closed :initarg :closed) - (merged :initarg :merged) - (unread-p :initarg :unread-p :initform nil) - (locked-p :initarg :locked-p) - (editable-p :initarg :editable-p) - (cross-repo-p :initarg :cross-repo-p) - (base-ref :initarg :base-ref) - (base-repo :initarg :base-repo) - (head-ref :initarg :head-ref) - (head-user :initarg :head-user) - (head-repo :initarg :head-repo) - (milestone :initarg :milestone) - (body :initarg :body) - (assignees :closql-table (pullreq-assignee assignee)) - (project-cards) ; projectsCards - (commits) - (edits) ; userContentEdits - (labels :closql-table (pullreq-label label)) - (participants) - (posts :closql-class forge-pullreq-post) - (reactions) - (review-requests :closql-table (pullreq-review-request assignee)) - (reviews) - (timeline) - (marks :closql-table (pullreq-mark mark)) - (note :initarg :note :initform nil) - ;; We don't use these fields: - ;; includesCreatedEdit (huh?), - ;; lastEditedAt (same as updatedAt?), - ;; publishedAt (same as createdAt?), - ;; activeLockReason, additions, authorAssociation, (baseRefName), baseRefOid, - ;; bodyHTML, bodyText, canBeRebased, changedFiles, closed, createdViaEmail, - ;; databaseId, deletions, editor, (headRefName), headRefOid, mergeCommit, - ;; mergeStateStatus, mergeable, merged, mergedBy, permalink, - ;; potentialMergeCommit,, reactionGroups, resourcePath, revertResourcePath, - ;; revertUrl, url, viewer{*} - )) - -(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) - ;; We don't use these fields: - ;; includesCreatedEdit (huh?), - ;; lastEditedAt (same as updatedAt?), - ;; publishedAt (same as createdAt?), - ;; pullRequest (same as issue), - ;; repository (use .pullreq.project), - ;; authorAssociation, bodyHTML, bodyText, createdViaEmail, - ;; editor, id, reactionGroups, resourcePath, url, viewer{*} - )) - -;;; 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)) - (when-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-branch-select (pullreq) - (let* ((number (oref pullreq number)) - (branch-n (format "pr-%s" number)) - (branch (or (forge--pullreq-branch-internal pullreq) - branch-n))) - (when (member branch '("master" "next" "maint")) - (setq branch branch-n)) - (when (magit-branch-p branch) - (if (equal branch branch-n) - (unless (y-or-n-p (format "Reset existing branch %S? " branch)) - (user-error "Abort")) - (pcase (read-char-choice - (format "A branch named %S already exists. - -This could be because you checked out this pull-request before, -in which case resetting might be the appropriate thing to do. - -Or the contributor worked directly on their version of a branch -that also exists on the upstream, in which case you probably -should not reset because you would end up resetting your version. - -Or you are trying to checkout a pull-request that you created -yourself, in which case you probably should not reset either. - - [r]eset existing %S branch - [c]reate new \"pr-%s\" branch instead - [a]bort" branch branch number) '(?r ?c ?a)) - (?r) - (?c (setq branch branch-n) - (when (magit-branch-p branch) - (error "Oh no! %S already exists too" branch))) - (?a (user-error "Abort")))) - (message "")) - branch)) - -(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) - (when-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)) - -;;; 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) - (when-let ((post (magit-section-value-if 'post))) - (cond ((forge-pullreq-p post) - post) - ((forge-pullreq-post-p post) - (forge-get-pullreq post)))))) - -(defvar forge-pullreqs-section-map - (let ((map (make-sparse-keymap))) - (define-key map [remap magit-browse-thing] 'forge-browse-pullreqs) - (define-key map [remap magit-visit-thing] 'forge-list-pullreqs) - (define-key map (kbd "C-c C-n") 'forge-create-pullreq) - map)) - -(defvar forge-pullreq-section-map - (let ((map (make-sparse-keymap))) - (define-key map [remap magit-browse-thing] 'forge-browse-pullreq) - (define-key map [remap magit-visit-thing] 'forge-visit-pullreq) - map)) - -(defun forge-insert-pullreqs () - "Insert a list of mostly recent and/or open pull-requests. -Also see option `forge-topic-list-limit'." - (when forge-display-in-status-buffer - (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) - (when-let ((range (forge--pullreq-range pullreq))) - (magit-insert-section-body - (cl-letf (((symbol-function #'magit-cancel-section) (lambda ()))) - (magit-insert-log 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-0.3.2/forge-repo.el b/elpa/forge-0.3.2/forge-repo.el @@ -1,370 +0,0 @@ -;;; forge-repo.el --- Repository support -*- lexical-binding: t -*- - -;; Copyright (C) 2018-2022 Jonas Bernoulli - -;; Author: Jonas Bernoulli <jonas@bernoul.li> -;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This file is not part of GNU Emacs. - -;; Forge 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, or (at your option) -;; any later version. -;; -;; Forge 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 Forge. If not, see http://www.gnu.org/licenses. - -;;; Code: - -(require 'forge) -(require 'eieio) - -;;; Classes - -(defclass forge-repository (forge-object) - ((closql-class-prefix :initform "forge-") - (closql-class-suffix :initform "-repository") - (closql-table :initform 'repository) - (closql-primary-key :initform 'id) - (issues-url-format :initform nil :allocation :class) - (issue-url-format :initform nil :allocation :class) - (issue-post-url-format :initform nil :allocation :class) - (pullreqs-url-format :initform nil :allocation :class) - (pullreq-url-format :initform nil :allocation :class) - (pullreq-post-url-format :initform nil :allocation :class) - (commit-url-format :initform nil :allocation :class) - (branch-url-format :initform nil :allocation :class) - (remote-url-format :initform nil :allocation :class) - (create-issue-url-format :initform nil :allocation :class) - (create-pullreq-url-format :initform nil :allocation :class) - (pullreq-refspec :initform nil :allocation :class) - (id :initform nil :initarg :id) - (forge-id :initform nil :initarg :forge-id) - (forge :initform nil :initarg :forge) - (owner :initform nil :initarg :owner) - (name :initform nil :initarg :name) - (apihost :initform nil :initarg :apihost) - (githost :initform nil :initarg :githost) - (remote :initform nil :initarg :remote) - (sparse-p :initform t) - (created :initform nil) - (updated :initform nil) - (pushed :initform nil) - (parent :initform nil) - (description :initform nil) - (homepage :initform nil) - (default-branch :initform nil) - (archived-p :initform nil) - (fork-p :initform nil) - (locked-p :initform nil) - (mirror-p :initform nil) - (private-p :initform nil) - (issues-p :initform t) - (wiki-p :initform nil) - (stars :initform nil) - (watchers :initform nil) - (assignees :closql-table assignee) - (forks :closql-table fork) - (issues :closql-class forge-issue) - (labels :closql-table label) - (pullreqs :closql-class forge-pullreq) - (revnotes :closql-class forge-revnote) - (selective-p :initform nil) - (worktree :initform nil) - (milestones :closql-table milestone)) - :abstract t) - -(defclass forge-unusedapi-repository (forge-repository) () :abstract t) - -(defclass forge-noapi-repository (forge-repository) () :abstract t) - -;;; Core - -(cl-defmethod forge--repository-ids ((class (subclass forge-repository)) - host owner name &optional stub) - "Return (OUR-ID . THEIR-ID) of the specified repository. -If optional STUB is non-nil, then the IDs are not guaranteed to -be unique. Otherwise this method has to make an API request to -retrieve THEIR-ID, the repository's ID on the forge. In that -case OUR-ID derives from THEIR-ID and is unique across all -forges and hosts." - (pcase-let* ((`(,_githost ,apihost ,id ,_class) - (or (assoc host forge-alist) - (error "No entry for %S in forge-alist" host))) - (path (format "%s/%s" owner name)) - (their-id (and (not stub) - (ghub-repository-id - owner name - :host apihost - :auth 'forge - :forge (forge--ghub-type-symbol class))))) - (cons (base64-encode-string - (format "%s:%s" id - (cond (stub path) - ((eq class 'forge-github-repository) - ;; This is base64 encoded, according to - ;; https://docs.github.com/en/graphql/reference/scalars#id. - ;; Unfortunately that is not always true. - ;; E.g. https://github.com/dit7ya/roamex. - (condition-case nil - (base64-decode-string their-id) - (error their-id))) - (t their-id))) - t) - (or their-id path)))) - -(cl-defmethod forge--repository-ids ((_class (subclass forge-noapi-repository)) - host owner name &optional _stub) - (let ((their-id (if owner (concat owner "/" name) name))) - (cons (base64-encode-string - (format "%s:%s" - (nth 3 (or (assoc host forge-alist) - (error "No entry for %S in forge-alist" host))) - their-id) - t) - their-id))) - -(defvar-local forge-buffer-repository nil) -(put 'forge-buffer-repository 'permanent-local t) - -(defconst forge--signal-no-entry '(t stub create)) - -(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) - (let* ((remotes (magit-list-remotes)) - (remote (or remote - (if (cdr remotes) - (car (member (forge--get-remote) remotes)) - (car remotes))))) - (if-let ((url (and remote - (magit-git-string "remote" "get-url" remote)))) - (when-let ((repo (forge-get-repository url remote demand))) - (oset repo worktree (magit-toplevel)) - repo) - (when (memq demand forge--signal-no-entry) - (error - "Cannot determine forge repository. %s\n%s %s" - (cond (remote (format "No url configured for %S." remote)) - (remotes "Cannot decide on remote to use.") - (t "No remote configured.")) - "You might have to set `forge.remote'." - "See 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--get-remote () - (or (magit-get "forge.remote") "origin")) - -(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 - (when-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 . ,(replace-regexp-in-string "/" "%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 (replace-regexp-in-string - "REPO" - (concat (oref repo owner) "/" (oref repo name)) - msg t))) - (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-0.3.2/forge-revnote.el b/elpa/forge-0.3.2/forge-revnote.el @@ -1,48 +0,0 @@ -;;; forge-revnote.el --- Revnote support -*- lexical-binding: t -*- - -;; Copyright (C) 2018-2022 Jonas Bernoulli - -;; Author: Jonas Bernoulli <jonas@bernoul.li> -;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This file is not part of GNU Emacs. - -;; Forge 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, or (at your option) -;; any later version. -;; -;; Forge 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 Forge. If not, see http://www.gnu.org/licenses. - -;;; Code: - -(require 'forge) -(require 'forge-post) -(require 'forge-topic) - -;;; Class - -(defclass forge-revnote (forge-topic) - ((closql-table :initform 'revnote) - (closql-primary-key :initform 'id) - ;; (closql-order-by :initform [(desc number)]) - (closql-foreign-key :initform 'repository) - (closql-class-prefix :initform "forge-") - (id :initarg :id) - (repository :initarg :repository) - (commit :initarg :commit) - (file :initarg :file) - (line :initarg :line) - (author :initarg :author) - (body :initarg :body))) - -;;; _ -(provide 'forge-revnote) -;;; forge-revnote.el ends here diff --git a/elpa/forge-0.3.2/forge-semi.el b/elpa/forge-0.3.2/forge-semi.el @@ -1,82 +0,0 @@ -;;; forge-semi.el --- Support for semi-forges -*- lexical-binding: t -*- - -;; Copyright (C) 2018-2022 Jonas Bernoulli - -;; Author: Jonas Bernoulli <jonas@bernoul.li> -;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This file is not part of GNU Emacs. - -;; Forge 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, or (at your option) -;; any later version. -;; -;; Forge 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 Forge. If not, see http://www.gnu.org/licenses. - -;;; Code: - -(require 'forge) - -(defclass forge-gitweb-repository (forge-noapi-repository) - ((commit-url-format :initform "https://%h/gitweb/?p=%P.git;a=commitdiff;h=%r") - (branch-url-format :initform "https://%h/gitweb/?p=%P.git;a=log;h=refs/heads/%r") - (remote-url-format :initform "https://%h/gitweb/?p=%P.git;a=summary")) - "Gitweb from https://git-scm.com/docs/gitweb.") - -(defclass forge-cgit-repository (forge-noapi-repository) - ((commit-url-format :initform "https://%h/%p.git/commit/?id=%r") - (branch-url-format :initform "https://%h/%p.git/log/?h=%r") - (remote-url-format :initform "https://%h/%p.git/about")) - "Cgit from https://git.zx2c4.com/cgit/about. -Different hosts use different url schemata, so we need multiple -classes. See their definitions in \"forge-semi.el\".") - -(defclass forge-cgit*-repository (forge-cgit-repository) - ((commit-url-format :initform "https://%h/cgit/%p.git/commit/?id=%r") - (branch-url-format :initform "https://%h/cgit/%p.git/log/?h=%r") - (remote-url-format :initform "https://%h/cgit/%p.git/about")) - "Cgit from https://git.zx2c4.com/cgit/about. -Different hosts use different url schemata, so we need multiple -classes. See their definitions in \"forge-semi.el\".") - -(defclass forge-cgit**-repository (forge-cgit-repository) - ((commit-url-format :initform "https://%h/cgit/%n.git/commit/?id=%r") - (branch-url-format :initform "https://%h/cgit/%n.git/log/?h=%r") - (remote-url-format :initform "https://%h/cgit/%n.git/about")) - "Cgit from https://git.zx2c4.com/cgit/about. -Different hosts use different url schemata, so we need multiple -classes. See their definitions in \"forge-semi.el\".") - -(defclass forge-repoorcz-repository (forge-cgit-repository) - ((commit-url-format :initform "https://%h/%p.git/commit/%r") - (branch-url-format :initform "https://%h/%p.git/log/%r") - (remote-url-format :initform "https://%h/%p.git")) - "Cgit fork used on https://repo.or.cz/cgit.git. -Different hosts use different url schemata, so we need multiple -classes. See their definitions in \"forge-semi.el\".") - -(defclass forge-stagit-repository (forge-noapi-repository) - ((commit-url-format :initform "https://%h/%n/commit/%r.html") - (branch-url-format :initform "https://%h/%n/refs.html") - (remote-url-format :initform "https://%h/%n/file/README.html")) - "Stagit from https://codemadness.org/git/stagit/file/README.html. -Only the history of \"master\" can be shown, so this links to the -list of refs instead of the log of the specified branch.") - -(defclass forge-srht-repository (forge-noapi-repository) - ((commit-url-format :initform "https://%h/~%o/%n/commit/%r") - (branch-url-format :initform "https://%h/~%o/%n/log/%r") - (remote-url-format :initform "https://%h/~%o/%n")) - "See https://meta.sr.ht.") - -;;; _ -(provide 'forge-semi) -;;; forge-semi.el ends here diff --git a/elpa/forge-0.3.2/forge-topic.el b/elpa/forge-0.3.2/forge-topic.el @@ -1,963 +0,0 @@ -;;; forge-topic.el --- Topics support -*- lexical-binding: t -*- - -;; Copyright (C) 2018-2022 Jonas Bernoulli - -;; Author: Jonas Bernoulli <jonas@bernoul.li> -;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This file is not part of GNU Emacs. - -;; Forge 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, or (at your option) -;; any later version. -;; -;; Forge 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 Forge. If not, see http://www.gnu.org/licenses. - -;;; Code: - -(require 'bug-reference) -(require 'markdown-mode) -(require 'parse-time) -(require 'yaml) - -(require 'forge) -(require 'forge-post) - -;;; 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 - (replace-regexp-in-string "\r\n" "\n" string t t) - "")) - -(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))) - -;;; Mode - -(defvar forge-topic-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-n") 'forge-create-post) - (define-key map (kbd "C-c C-r") 'forge-create-post) - (define-key map [remap magit-browse-thing] 'forge-browse-topic) - (define-key map [remap magit-visit-thing] 'markdown-follow-link-at-point) - (define-key map [mouse-2] 'markdown-follow-link-at-point) - map)) - -(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-refs - forge-insert-topic-milestone - forge-insert-topic-labels - forge-insert-topic-marks - forge-insert-topic-assignees - forge-insert-topic-review-requests)) - -(defvar forge-post-section-map - (let ((map (make-sparse-keymap))) - (define-key map [remap magit-browse-thing] 'forge-browse-post) - (define-key map [remap magit-edit-thing] 'forge-edit-post) - (define-key map (kbd "C-c C-k") 'forge-delete-comment) - map)) - -(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 (and (forge-pullreq-p topic) - (not (oref topic merged))) - (magit-insert-section (pullreq topic) - (magit-insert-heading "Commits") - (forge--insert-pullreq-commits topic))) - (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)))))) - (add-face-text-property 0 (length heading) - 'magit-diff-hunk-heading t 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 forge-topic-title-section-map - (let ((map (make-sparse-keymap))) - (define-key map [remap magit-edit-thing] 'forge-edit-topic-title) - map)) - -(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 forge-topic-state-section-map - (let ((map (make-sparse-keymap))) - (define-key map [remap magit-edit-thing] 'forge-edit-topic-state) - map)) - -(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 forge-topic-milestone-section-map - (let ((map (make-sparse-keymap))) - (define-key map [remap magit-edit-thing] 'forge-edit-topic-milestone) - map)) - -(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) - (when-let ((id (oref topic milestone))) - (caar (forge-sql [:select [title] :from milestone :where (= id $s1)] id)))) - -(defvar forge-topic-labels-section-map - (let ((map (make-sparse-keymap))) - (define-key map [remap magit-edit-thing] 'forge-edit-topic-labels) - map)) - -(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) - (when-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 forge-topic-marks-section-map - (let ((map (make-sparse-keymap))) - (define-key map [remap magit-edit-thing] 'forge-edit-topic-marks) - map)) - -(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 forge-topic-assignees-section-map - (let ((map (make-sparse-keymap))) - (define-key map [remap magit-edit-thing] 'forge-edit-topic-assignees) - map)) - -(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 forge-topic-review-requests-section-map - (let ((map (make-sparse-keymap))) - (define-key map [remap magit-edit-thing] 'forge-edit-topic-review-requests) - map)) - -(cl-defun forge-insert-topic-review-requests - (&optional (topic forge-buffer-topic)) - (when (and (forge-github-repository-p (forge-get-repository topic)) - (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)) - ;; Unlike for issues, Github ignores the yaml front-matter for - ;; pull-requests. We just assume that nobody tries to use it - ;; anyway. If that turned out to be wrong, we would have to - ;; deal with it by complicating matters around here. - (let ((alist (or (and (forge--childp (forge-get-repository t) - 'forge-github-repository) - (save-excursion (forge--topic-parse-yaml))) - (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)) - (let-alist alist - (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)))))) - 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 bug-reference-url-format - (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))))) - -(when (and (not noninteractive) forge--sqlite-available-p) - (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-0.3.2/forge.el b/elpa/forge-0.3.2/forge.el @@ -1,155 +0,0 @@ -;;; forge.el --- Access Git forges from Magit -*- lexical-binding: t -*- - -;; Copyright (C) 2018-2022 Jonas Bernoulli - -;; Author: Jonas Bernoulli <jonas@bernoul.li> -;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> -;; Homepage: https://github.com/magit/forge -;; Keywords: git tools vc -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This file is not part of GNU Emacs. - -;; Forge 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, or (at your option) -;; any later version. -;; -;; Forge 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 Forge. If not, see http://www.gnu.org/licenses. - -;;; Commentary: - -;; Work with Git forges, such as Github and Gitlab, from the comfort -;; of Magit and the rest of Emacs. - -;; The schema of the database has not been finalized yet. Until that -;; has happened it will occasionally have to be discarded. For now -;; the database does not contain any information that cannot simply -;; be fetched again. - -;;; Code: - -(require 'magit) - -(require 'forge-db) -(require 'forge-core) - -(provide 'forge) - -(require 'forge-repo) -(require 'forge-post) -(require 'forge-topic) -(require 'forge-issue) -(require 'forge-pullreq) -(require 'forge-revnote) -(require 'forge-notify) - -(require 'forge-github) -(require 'forge-gitlab) -(require 'forge-gitea) -(require 'forge-gogs) -(require 'forge-bitbucket) -(require 'forge-semi) - -(require 'forge-commands) -(require 'forge-list) - -;;; Add Sections - -(defvar forge-add-default-sections t - "Whether to add Forge's sections to `magit-status-sections-hook'. -If you want to disable this, then you must set this to nil before -`forge' is loaded.") - -(when (and forge-add-default-sections forge--sqlite-available-p) - (magit-add-section-hook 'magit-status-sections-hook 'forge-insert-pullreqs nil t) - (magit-add-section-hook 'magit-status-sections-hook 'forge-insert-issues nil t)) - -;;; Add Bindings - -;;;###autoload -(defvar forge-add-default-bindings t - "Whether to add Forge's bindings to various Magit keymaps. -If you want to disable this, then you must set this to nil before -`magit' is loaded. If you do it before `forge' but after `magit' -is loaded, then `magit-mode-map' ends up being modified anyway.") - -;;;###autoload -(with-eval-after-load 'magit-mode - (when forge-add-default-bindings - (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-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-0.3.2/forge.info b/elpa/forge-0.3.2/forge.info @@ -1,1428 +0,0 @@ -This is forge.info, produced by makeinfo version 6.7 from forge.texi. - - Copyright (C) 2018-2022 Jonas Bernoulli <jonas@bernoul.li> - - You can redistribute this document and/or modify it under the terms - of the GNU General Public License as published by the Free Software - Foundation, either version 3 of the License, or (at your option) - any later version. - - This document is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - General Public License for more details. - -INFO-DIR-SECTION Emacs -START-INFO-DIR-ENTRY -* Forge: (forge). Access Git Forges from Magit. -END-INFO-DIR-ENTRY - - -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. - - Copyright (C) 2018-2022 Jonas Bernoulli <jonas@bernoul.li> - - You can redistribute this document and/or modify it under the terms - of the GNU General Public License as published by the Free Software - Foundation, either version 3 of the License, or (at your option) - any later version. - - This document is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - General Public License for more details. - -* Menu: - -* Introduction:: -* Supported Forges and Hosts:: -* Getting Started:: -* Usage:: -* Other Options:: -* 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 - -* 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 -<https://gitlab.com> and <https://salsa.debian.org> are both instances -of the Gitlab forge. Forge supports some well known hosts out of the -box and additional hosts can easily be supported by adding entries to -the option ‘forge-alist’. - - For more details about the caveats mentioned below (and some others) -also see *note Getting Started::. - -* Menu: - -* Supported Forges:: -* Partially Supported Forges:: -* Supported Semi-Forges:: - - -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. - - • Forge depends on the ‘updated_at’ field being updated when - appropriate. For Github pull-requests at least, that is not always - done. - -Github Hosts -............ - - • <https://github.com> - -Gitlab ------- - -Gitlab Caveats -.............. - - • Forge cannot provide notifications because the Gitlab API does not - expose those. - -Gitlab Hosts -............ - - • <https://gitlab.com> - • <https://salsa.debian.org> - • <https://framagit.org> - - -File: forge.info, Node: Partially Supported Forges, Next: Supported Semi-Forges, Prev: Supported Forges, Up: Supported Forges and Hosts - -2.2 Partially Supported Forges -============================== - -Gitea https://gitea.io ----------------------- - -This is the next forge whose API will be supported. - -Gitea Hosts -........... - - • <https://codeberg.org> - -Gogs https://gogs.io --------------------- - -Once Gitea is supported it should be fairly simple to support Gogs too, -because the former is a fork of the latter and the APIs seem to still be -very similar. - -Gogs Hosts -.......... - - • <https://code.orgmode.org> - -Bitbucket https://bitbucket.org -------------------------------- - -I don’t plan to support Bitbucket’s API any time soon, and it gets less -likely that I will every do it every time I look at it. - -Bitbucket Caveats -................. - - • The API documentation is poor and initial tests indicated that the - implementation is buggy. - - • Atlassian’s offering contains two very distinct implementations - that are both called "Bitbucket". Forge only supports the - implementation whose only instance is available at - <https://bitbucket.org>, because I only have access to that. - - • Unlike all other forges, Bitbucket does not expose pull-requests as - references in the upstream repository. For that reason Forge - actually treats it as a semi-forge, not as forge whose API is not - supported yet. This means that you cannot checkout pull-requests - locally. There is little hope that this will ever get fixed; the - respective issue was opened six years ago and there has been no - progress since: <https://bitbucket.org/site/master/issues/5814>. - -Bitbucket Hosts -............... - - • <https://bitbucket.org> - - -File: forge.info, Node: Supported Semi-Forges, Prev: Partially Supported Forges, Up: Supported Forges and Hosts - -2.3 Supported Semi-Forges -========================= - -Gitweb https://git-scm.com/docs/gitweb --------------------------------------- - -Gitweb Caveats -.............. - - • I could find only one public installation - (<https://git.savannah.gnu.org>), which gives users the choice - between Gitweb and Cgit. The latter seems more popular (not just - on this site). - -Cgit https://git.zx2c4.com/cgit/about -------------------------------------- - -Cgit Caveats -............ - - • Different sites use different URL schemata and some of the bigger - sites use a fork. For this reason Forge has to provide several - classes to support different variations of Cgit and you have to - look at their definitions to figure out which one is the correct - one for a particular installation. - -Cgit Hosts -.......... - - • <https://git.savannah.gnu.org/cgit> - • <https://git.kernel.org> - • <https://repo.or.cz> - -Stgit https://codemadness.org/git/stagit/file/README.html ---------------------------------------------------------- - -Stgit Caveats -............. - - • Stgit cannot show logs for branches beside "master". For that - reason Forge takes users to a page listing the branches when they - request the log for a particular branch (even for "master" whose - log is just one click away from there). - -Stgit Hosts -........... - - • <https://git.suckless.org> - -Srht https://meta.sr.ht ------------------------ - -Srht Caveats -............ - - • Srht cannot show logs for branches beside "master". For that - reason Forge takes users to a page listing the branches when they - request the log for a particular branch (even for "master" whose - log is just one click away from there). - -Srht Hosts -.......... - - • <https://git.sr.ht> - - -File: forge.info, Node: Getting Started, Next: Usage, Prev: Supported Forges and Hosts, Up: Top - -3 Getting Started -***************** - -Getting started using Forge should be fairly easy provided you take the -time to read the documentation. First see *note (ghub)Getting Started:: -from Ghub’s manual. Ghub is the library that Forge uses to communicate -with forge APIs. While Ghub can be used independently of Forge, its -"Getting Started" part was written with Forge users in mind. - - Please begin reading in *note (ghub)Getting Started:: and then come -back here and make sure to read the subsections. - - Loading Magit doesn’t cause Forge to be loaded automatically. Adding -something like this to your init file takes care of this: - - (with-eval-after-load 'magit - (require 'forge)) - - Or if you use ‘use-package’: - - (use-package forge - :after magit) - -* Menu: - -* Token Creation:: -* Initial Pull:: -* Repository Detection:: -* Caveats:: - - -File: forge.info, Node: Token Creation, Next: Initial Pull, Up: Getting Started - -3.1 Token Creation -================== - -Forge uses the Ghub package to access the APIs of supported Git forges. -How this works and how to create and store a token is documented in -*note (ghub)Getting Started::. - - Ghub used to provide a setup wizard, but that had to be removed for -reasons given in the manual just mentioned. Nowadays there is no way -around reading the documentation and doing this manually I am afraid. - - Forge requires the following token scopes. - - • For Github these scopes are required. - - • ‘repo’ grants full read/write access to private and public - repositories. - • ‘user’ grants access to profile information. - • ‘read:org’ grants read-only access to organization membership. - - More information about these and other scopes can be found at - <https://docs.github.com/en/developers/apps/scopes-for-oauth-apps>. - - • For Gitlab instances ‘api’ is the only required scope. It gives - read and write access to everything. The Gitlab API provides more - fine-grained scopes for read-only access, but when any write access - at all is required, then it is all or nothing. - - -File: forge.info, Node: Initial Pull, Next: Repository Detection, Prev: Token Creation, Up: Getting Started - -3.2 Initial Pull -================ - -To start using Forge in a certain repository visit the Magit status -buffer for that repository and type ‘f n’ (‘forge-pull’). -Alternatively, you can use ‘M-x forge-add-repository’, which makes it -possible to add a forge repository without pulling all topics and even -without having to clone the respective Git repository. - - You must set up a token *before* you can add the first repository. -See *note Token Creation::. - - The first time ‘forge-pull’ is run in a repository, an entry for that -repository is added to the database and a new value is added to the Git -variable ‘remote.<remote>.fetch’, which fetches all pull-requests. -(‘+refs/pull/*/head:refs/pullreqs/*’ for Github) - - ‘forge-pull’ then fetches topics and other information using the -forge’s API and pull-request references using Git. - - The initial fetch can take a while but most of that is done -asynchronously. Storing the information in the database is done -synchronously though, so there can be a noticeable hang at the end. -Subsequent fetches are much faster. - - Fetching issues from Github is much faster than fetching from other -forges because making a handful of GraphQL requests is much faster than -making hundreds of REST requests. - - -File: forge.info, Node: Repository Detection, Next: Caveats, Prev: Initial Pull, Up: Getting Started - -3.3 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 ‘FORGE.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. If -several remotes exist, then a remote may be selected based on its name. - - The convention is to name the upstream remote ‘origin’. If you -follow this convention, then you have to do nothing else and the remote -by that name is automatically used, provided it exists and regardless of -whether other remotes exist. If it does not exist, then no other -remotes are tried. - - If you do not follow the naming convention, then you have to inform -Forge about that by setting the Git variable ‘forge.remote’ to the name -that you instead use for upstream remotes. - -‘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.4 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: Other Options, 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.<name>.pullRequest’ is set to the pull-request number. - • ‘branch.<name>.pullRequestRemote’ is set to the remote on - which the pull-request branch is located. - • ‘branch.<name>.pushRemote’ is set to the same remote as - ‘branch.<name>.pullRequestRemote’ if that is possible, - otherwise it is set to the upstream remote. - • ‘branch.<name>.description’ is set to the pull-request title. - • ‘branch.<name>.rebase’ is set to ‘true’ because there should - be no merge commits among the commits in a pull-request. - - This command also configures the upstream and the push-remote of - the local branch that it creates. - - The branch against which the pull-request was opened is always used - as the upstream. This makes it easy to see what commits you are - being asked to merge in the section titled something like "Unmerged - into origin/master". - - Like for other commands that create a branch, it depends on the - option ‘magit-branch-prefer-remote-upstream’ whether the remote - branch itself or the respective local branch is used as the - upstream, so this section may also be titled e.g. "Unmerged into - master". - - When necessary and possible, the remote pull-request branch is - configured to be used as the push-target. This makes it easy to - see what further changes the contributor has made since you last - reviewed their changes in the section titled something like - "Unpulled from origin/new-feature" or "Unpulled from - fork/new-feature". - - • If the pull-request branch is located in the upstream - repository, then you probably have set ‘remote.pushDefault’ to - that repository. However some users like to set that variable - to their personal fork, even if they have push access to the - upstream, so ‘branch.<name>.pushRemote’ is set anyway. - - • If the pull-request branch is located inside a fork, then you - are usually able to push to that branch, because Github by - default allows the recipient of a pull-request to push to the - remote pull-request branch even if it is located in a fork. - The contributor has to explicitly disable this. - - • If you are not allowed to push to the pull-request branch - on the fork, then a branch by the same name located in - the upstream repository is configured as the push-target. - - • A—sadly rather common—special case is when the - contributor didn’t bother to use a dedicated branch for - the pull-request. - - The most likely such case is when you are being asked to - merge something like "fork/master" into "origin/master". - The special push permission mentioned above is never - granted for the branch that is the repository’s default - branch, and that would almost certainly be the case in - this scenario. - - To enable you to easily push somewhere anyway, the local - branch is named "pr-N" (where ‘N’ is the pull-request - number) and the upstream repository is used as the - push-remote. - - • Finally, if you are allowed to push to the pull-request - branch and the contributor had the foresight to use a - dedicated branch, then the fork is configured as the - push-remote. - - The push-remote is configured using - ‘branch.<name>.pushRemote’, even if the used value is - identical to that of ‘remote.pushDefault’, just in case you - change the value of the latter later on. Additionally the - variable ‘branch.<name>.pullRequestRemote’ is set to the - remote on which the pull-request branch is located. - -‘b n’ (‘forge-checkout-pullreq’) - This command creates and configures a new branch from a - pull-request the same way ‘forge-branch-pullreq’ does. - Additionally it checks out the new branch. - -‘Z n’ (‘forge-checkout-worktree’) - This command creates and configures a new branch from a - pull-request the same way ‘forge-branch-pullreq’ does. - Additionally it checks out the new branch using a new working tree. - -User Options: forge-checkout-worktree-read-directory-function - This function is used by ‘forge-checkout-worktree’ to read read the - new worktree directory where it checks out to pull-request. It - takes the pull-request as the only argument and must return a - directory. - - When you delete a pull-request branch, which was created using one of -the above three commands, then ‘magit-branch-delete’ usually offers to -also delete the corresponding remote. It does not offer to delete a -remote if (1) the remote is the upstream remote, and/or (2) if other -branches are being fetched from the remote. - - Note that you have to delete the local branch (e.g. "feature") for -this to work. If you delete the tracking branch (e.g "fork/feature"), -then the remote is never removed. - - -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 I’ (‘forge-browse-issues’) -‘N b P’ (‘forge-browse-pullreqs’) -‘N b t’ (‘forge-browse-topic’) -‘N b i’ (‘forge-browse-issue’) -‘N b p’ (‘forge-browse-pullreq’) - These commands visit the topic, issue(s), pull-request(s), post, - branch, commit, or remote at point in a browser. - - This is implemented using various commands named - ‘forge-browse-TYPE’, and the key binding is defined by remapping - ‘magit-browse-thing’ (as defined in ‘magit-mode-map)’. For commit - sections this key is bound to ‘forge-browse-dwim’, which prefers a - topic over a branch and a branch over a commit. - -‘<RET>’ (‘forge-visit-TYPE’) -‘C-c C-v’ (‘forge-visit-topic’) -‘N v t’ (‘forge-visit-topic’) -‘N v i’ (‘forge-visit-issue’) -‘N v p’ (‘forge-visit-pullreq’) - These commands visit the pull-request(s), issue(s), or repository - in a separate buffer. - - The ‘RET’ binding is only available when point is on a issue or - pull-request section because that key is already bound to something - else for most of Magit’s own sections. ‘C-c C-v’ however is also - available on regular commit (e.g. in a log) and branch sections. - - This is implemented using various commands named ‘forge-visit-TYPE’ - and the key binding is defined by remapping ‘magit-visit-thing’ (as - defined in ‘magit-mode-map’). - - -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 "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. - - -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 datbase 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: Other Options, Next: FAQ, Prev: Usage, Up: Top - -5 Other Options -*************** - - -- User Option: forge-database-connector - This option controls which database connector is used by Forge. - - This must be set before ‘forge’ is loaded. To use an alternative - connector you must install the respective package explicitly. - - • When ‘sqlite’, then use the ‘emacsql-sqlite’ library that is - being maintained in the same repository as ‘emacsql’ itself. - - • When ‘libsqlite3’, then use the ‘emacsql-libsqlite’ library, - which itself uses a module provided by the ‘sqlite3’ package. - This is still experimental. - - • When ‘sqlite3’, then use the ‘emacsql-sqlite3’ library, which - uses the official ‘sqlite3’ command-line tool, which I do not - recommended because it is not suitable to be used like this, - but has the advantage that you likely don’t need a compiler. - See <https://nullprogram.com/blog/2014/02/06/>. - - -File: forge.info, Node: FAQ, Next: Keystroke Index, Prev: Other Options, Up: Top - -Appendix A FAQ -************** - -* 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 occuring error. Adding some formatting the full -error is: - - error in process filter: ghub--signal-error: HTTP Error: 502, - "Bad gateway", "/graphql", - ((data . "null") - (errors ((message . "Something went wrong while executing your query. - This may be the result of a timeout, or it could be a GitHub bug. - Please include `CC2C:4FEA:A1771C1:CBF40CE:5C33F7E5` - when reporting this issue.")))) - - This indicates that something went wrong within Github’s network. -See -<https://en.wikipedia.org/wiki/List_of_HTTP_status_codes#5xx_server_errors>. -The appended error message also says as much: "This may be the result of -a timeout, or it could be a GitHub bug." - - It appears that this happens more often in big repositories, -especially during the initial pull, but this may be an illusion; it is -known to also happens for smaller, incremental requests. - - I believe that more data just means more requests and thus more -opportunities for things to go wrong. It seems unlikely that this is -due to us requesting too much data at once (in that case we would get a -different error from GraphQL, not HTTP). When fetching lots of data, -then we do not request one large response but make many requests and we -then collect the many responses (pagination forces us to do that). - - The timeout may be due to many requests from other people arriving at -some Github-internal bottleneck at the same time, or it may be due to -cold caches and overly aggressive timeouts. We just don’t know; it’s -their infrastructure. - - The second problem is that we currently simply error out if we get -this error. This could be changed and eventually it will be, but for -the time being your only option is to just try again, possibly -repeatedly and possibly after a delay to give whatever congestion may -exist on the other end a chance to clear or to give their caches a -chance to warm up. - - This was also discussed in <https://github.com/magit/forge/issues/20> -and <https://github.com/magit/ghub/issues/83>. - - -File: forge.info, Node: Keystroke Index, Next: Function and Command Index, Prev: FAQ, Up: Top - -Appendix B Keystroke Index -************************** - - -* Menu: - -* b N: Branching. (line 13) -* b n: Branching. (line 102) -* C-c C-c: Editing Topics and Posts. - (line 89) -* C-c C-e [on "Assignees" section]: Editing Topics and Posts. - (line 53) -* C-c C-e [on "Labels" section]: Editing Topics and Posts. - (line 40) -* C-c C-e [on "Marks" section]: Editing Topics and Posts. - (line 44) -* C-c C-e [on "Note" section]: Editing Topics and Posts. - (line 62) -* C-c C-e [on "Review-Requests" section]: Editing Topics and Posts. - (line 57) -* 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 93) -* C-c C-k [on a comment section]: Editing Topics and Posts. - (line 65) -* 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 35) -* C-c C-w: Visiting Topics. (line 21) -* C-c C-w <1>: Visiting Topics. (line 21) -* f n: Pulling. (line 13) -* f N: Pulling. (line 25) -* m M [if enabled]: Editing Topics and Posts. - (line 69) -* N: Usage. (line 23) -* N a: Usage. (line 13) -* N a <1>: Miscellaneous. (line 15) -* N b I: Visiting Topics. (line 21) -* N b i: Visiting Topics. (line 21) -* N b P: Visiting Topics. (line 21) -* N b p: Visiting Topics. (line 21) -* N b t: Visiting Topics. (line 21) -* 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 69) -* N r: Repository Detection. - (line 28) -* N t c: Miscellaneous. (line 28) -* N t t: Miscellaneous. (line 24) -* N v i: Visiting Topics. (line 35) -* N v p: Visiting Topics. (line 35) -* N v t: Visiting Topics. (line 35) -* RET: Visiting Topics. (line 35) -* 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 -************************************* - - -* 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 21) -* forge-browse-issue: Visiting Topics. (line 21) -* forge-browse-issues: Visiting Topics. (line 21) -* forge-browse-pullreq: Visiting Topics. (line 21) -* forge-browse-pullreqs: Visiting Topics. (line 21) -* forge-browse-topic: Visiting Topics. (line 21) -* forge-browse-TYPE: Visiting Topics. (line 21) -* 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 65) -* forge-dispatch: Usage. (line 23) -* forge-edit-post: Editing Topics and Posts. - (line 27) -* forge-edit-topic-assignees: Editing Topics and Posts. - (line 53) -* forge-edit-topic-labels: Editing Topics and Posts. - (line 40) -* forge-edit-topic-marks: Editing Topics and Posts. - (line 44) -* forge-edit-topic-note: Editing Topics and Posts. - (line 62) -* forge-edit-topic-review-requests: Editing Topics and Posts. - (line 57) -* 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 28) -* 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 69) -* forge-post-cancel: Editing Topics and Posts. - (line 93) -* forge-post-submit: Editing Topics and Posts. - (line 89) -* 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 35) -* forge-visit-pullreq: Visiting Topics. (line 35) -* forge-visit-topic: Visiting Topics. (line 35) -* forge-visit-TYPE: Visiting Topics. (line 35) - - -File: forge.info, Node: Variable Index, Prev: Function and Command Index, Up: Top - -Appendix D Variable Index -************************* - - -* Menu: - -* forge-database-connector: Other Options. (line 6) -* 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) - - - -Tag Table: -Node: Top751 -Node: Introduction2428 -Node: Supported Forges and Hosts2991 -Node: Supported Forges4241 -Ref: Github4397 -Ref: Github Caveats4540 -Ref: Github Hosts4894 -Ref: Gitlab4950 -Ref: Gitlab Caveats4965 -Ref: Gitlab Hosts5090 -Node: Partially Supported Forges5210 -Ref: Gitea https//giteaio5416 -Ref: Gitea Hosts5516 -Ref: Gogs https//gogsio5572 -Ref: Gogs Hosts5775 -Ref: Bitbucket https//bitbucketorg5833 -Ref: Bitbucket Caveats6031 -Ref: Bitbucket Hosts6928 -Node: Supported Semi-Forges6993 -Ref: Gitweb https//git-scmcom/docs/gitweb7164 -Ref: Gitweb Caveats7243 -Ref: Cgit https//gitzx2c4com/cgit/about7483 -Ref: Cgit Caveats7560 -Ref: Cgit Hosts7909 -Ref: Stgit https//codemadnessorg/git/stagit/file/READMEhtml8036 -Ref: Stgit Caveats8153 -Ref: Stgit Hosts8439 -Ref: Srht https//metasrht8499 -Ref: Srht Caveats8548 -Ref: Srht Hosts8831 -Node: Getting Started8882 -Node: Token Creation9853 -Node: Initial Pull11110 -Node: Repository Detection12505 -Node: Caveats14425 -Node: Usage15351 -Node: Pulling16833 -Node: Branching19516 -Node: Working with Topics25905 -Node: Visiting Topics26278 -Node: Listing Topics and Notifications28315 -Node: Creating Topics33640 -Node: Editing Topics and Posts34129 -Node: Miscellaneous38145 -Node: Other Options40767 -Node: FAQ41847 -Node: Is it possible to create a single pull-request without pulling everything?42172 -Node: error in process filter HTTP Error 502 "Bad gateway"42638 -Node: Keystroke Index45008 -Node: Function and Command Index50205 -Node: Variable Index57670 - -End Tag Table - - -Local Variables: -coding: utf-8 -End: diff --git a/init.el b/init.el @@ -353,7 +353,7 @@ ("melpa-stable" . "https://stable.melpa.org/packages/") ("melpa" . "https://melpa.org/packages/"))) '(package-selected-packages - '(ox-epub ob-powershell powershell web-mode lexic editorconfig forge elfeed-tube-mpv elfeed-tube cider restclient-jq graphviz-dot-mode consult-eglot jq-mode multiple-cursors ob-restclient restclient vterm deadgrep helpful pdf-tools paredit-menu paredit corfu sly eglot aggressive-indent project nov nhexl-mode elfeed magit yaml-mode json-mode lua-mode go-mode geiser-guile geiser org-roam org-contrib org ace-window expand-region consult marginalia uuidgen request diminish which-key)) + '(ox-epub ob-powershell powershell web-mode lexic editorconfig elfeed-tube-mpv elfeed-tube cider restclient-jq graphviz-dot-mode consult-eglot jq-mode multiple-cursors ob-restclient restclient vterm deadgrep helpful pdf-tools paredit-menu paredit corfu sly eglot aggressive-indent project nov nhexl-mode elfeed magit yaml-mode json-mode lua-mode go-mode geiser-guile geiser org-roam org-contrib org ace-window expand-region consult marginalia uuidgen request diminish which-key)) '(pcomplete-ignore-case t t) '(pixel-scroll-precision-mode t) '(read-buffer-completion-ignore-case t)