From de68a59036f12ed3a9aba3494abbdae516dbff88 Mon Sep 17 00:00:00 2001 From: Andreas Gerler Date: Wed, 24 Dec 2025 13:30:46 +0100 Subject: [PATCH] update forge --- bba.org | 2 +- elpa/forge-20250516.1009/forge-post.el | 270 ---- .../.dir-locals.el | 0 .../dir | 0 .../forge-autoloads.el | 20 +- .../forge-bitbucket.el | 1 - elpa/forge-20251201.1658/forge-client.el | 159 +++ .../forge-commands.el | 364 +++--- .../forge-core.el | 128 +- .../forge-db.el | 29 +- .../forge-discussion.el | 69 +- .../forge-forgejo.el | 0 .../forge-gitea.el | 8 +- .../forge-github.el | 1101 +++++++++-------- .../forge-gitlab.el | 239 ++-- .../forge-gogs.el | 1 - .../forge-issue.el | 27 +- .../forge-notify.el | 39 +- .../forge-pkg.el | 24 +- elpa/forge-20251201.1658/forge-post.el | 418 +++++++ .../forge-pullreq.el | 63 +- .../forge-repo.el | 304 +++-- .../forge-repos.el | 15 +- .../forge-revnote.el | 6 +- .../forge-semi.el | 0 .../forge-tablist.el | 6 +- .../forge-topic.el | 385 +++--- .../forge-topics.el | 66 +- .../forge.el | 35 +- .../forge.info | 270 ++-- 30 files changed, 2336 insertions(+), 1713 deletions(-) delete mode 100644 elpa/forge-20250516.1009/forge-post.el rename elpa/{forge-20250516.1009 => forge-20251201.1658}/.dir-locals.el (100%) rename elpa/{forge-20250516.1009 => forge-20251201.1658}/dir (100%) rename elpa/{forge-20250516.1009 => forge-20251201.1658}/forge-autoloads.el (95%) rename elpa/{forge-20250516.1009 => forge-20251201.1658}/forge-bitbucket.el (99%) create mode 100644 elpa/forge-20251201.1658/forge-client.el rename elpa/{forge-20250516.1009 => forge-20251201.1658}/forge-commands.el (85%) rename elpa/{forge-20250516.1009 => forge-20251201.1658}/forge-core.el (80%) rename elpa/{forge-20250516.1009 => forge-20251201.1658}/forge-db.el (96%) rename elpa/{forge-20250516.1009 => forge-20251201.1658}/forge-discussion.el (83%) rename elpa/{forge-20250516.1009 => forge-20251201.1658}/forge-forgejo.el (100%) rename elpa/{forge-20250516.1009 => forge-20251201.1658}/forge-gitea.el (89%) rename elpa/{forge-20250516.1009 => forge-20251201.1658}/forge-github.el (55%) rename elpa/{forge-20250516.1009 => forge-20251201.1658}/forge-gitlab.el (82%) rename elpa/{forge-20250516.1009 => forge-20251201.1658}/forge-gogs.el (99%) rename elpa/{forge-20250516.1009 => forge-20251201.1658}/forge-issue.el (91%) rename elpa/{forge-20250516.1009 => forge-20251201.1658}/forge-notify.el (91%) rename elpa/{forge-20250516.1009 => forge-20251201.1658}/forge-pkg.el (50%) create mode 100644 elpa/forge-20251201.1658/forge-post.el rename elpa/{forge-20250516.1009 => forge-20251201.1658}/forge-pullreq.el (85%) rename elpa/{forge-20250516.1009 => forge-20251201.1658}/forge-repo.el (66%) rename elpa/{forge-20250516.1009 => forge-20251201.1658}/forge-repos.el (95%) rename elpa/{forge-20250516.1009 => forge-20251201.1658}/forge-revnote.el (90%) rename elpa/{forge-20250516.1009 => forge-20251201.1658}/forge-semi.el (100%) rename elpa/{forge-20250516.1009 => forge-20251201.1658}/forge-tablist.el (94%) rename elpa/{forge-20250516.1009 => forge-20251201.1658}/forge-topic.el (88%) rename elpa/{forge-20250516.1009 => forge-20251201.1658}/forge-topics.el (91%) rename elpa/{forge-20250516.1009 => forge-20251201.1658}/forge.el (92%) rename elpa/{forge-20250516.1009 => forge-20251201.1658}/forge.info (95%) diff --git a/bba.org b/bba.org index f4672444..202ef931 100644 --- a/bba.org +++ b/bba.org @@ -959,7 +959,7 @@ I still like ido-find-file. [2023-01-17 Tue 09:33] #+begin_src emacs-lisp - (add-to-list 'load-path "~/.emacs.d/elpa/forge-20250516.1009") + (add-to-list 'load-path "~/.emacs.d/elpa/forge-20251201.1658") (with-eval-after-load 'magit (require 'forge)) diff --git a/elpa/forge-20250516.1009/forge-post.el b/elpa/forge-20250516.1009/forge-post.el deleted file mode 100644 index 488ec213..00000000 --- a/elpa/forge-20250516.1009/forge-post.el +++ /dev/null @@ -1,270 +0,0 @@ -;;; forge-post.el --- Post support -*- lexical-binding:t -*- - -;; Copyright (C) 2018-2025 Jonas Bernoulli - -;; Author: Jonas Bernoulli -;; Maintainer: Jonas Bernoulli - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This file is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published -;; by the Free Software Foundation, either version 3 of the License, -;; or (at your option) any later version. -;; -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this file. If not, see . - -;;; Code: - -(require 'markdown-mode) - -(require 'forge) - -;;; Options - -(defcustom forge-post-mode-hook - '(visual-line-mode - turn-on-flyspell) - "Hook run after entering Forge-Post mode." - :package-version '(forge . "0.2.0") - :group 'forge - :type 'hook - :options '(visual-line-mode - turn-on-flyspell)) - -(defcustom forge-post-fallback-directory - (locate-user-emacs-file "forge-drafts/") - "Directory used to store post drafts for locally unavailable repositories. -Normally drafts are stored inside the Git directory. If that does not -exist (or its location is unknown), then this directory is used instead." - :package-version '(forge . "0.4.7") - :group 'forge - :type 'directory) - -(defcustom forge-buffer-draft-p nil - "Whether new pull-requests start out as drafts by default. - -The buffer-local value is used to keep track of the draft status -of the current pull-request." - :package-version '(forge . "0.4.0") - :group 'forge - :type 'boolean) - -;;; Class - -(defclass forge-post (forge-object) () :abstract t) - -;;; Query -;;;; Get - -(cl-defmethod forge-get-parent ((post forge-post)) - (forge-get-topic post)) - -(cl-defmethod forge-get-repository ((post forge-post)) - (forge-get-repository (forge-get-topic post))) - -;;;; Current - -(defun forge-post-at-point (&optional assert) - "Return the post at point. -If there is no such post and DEMAND is non-nil, then signal -an error." - (or (magit-section-value-if '(issue pullreq post)) - (and assert (user-error "There is no post at point")))) - -(defun forge-comment-at-point (&optional assert) - "Return the comment at point. -If there is no such comment and DEMAND is non-nil, then signal -an error." - (or (and (magit-section-value-if '(post)) - (let ((post (oref (magit-current-section) value))) - (and (or (forge-pullreq-post-p post) - (forge-issue-post-p post)) - post))) - (and assert (user-error "There is no comment at point")))) - -;;; Utilities - -(cl-defmethod forge--format ((post forge-post) slot &optional spec) - (forge--format (forge-get-topic post) slot - `(,@spec (?I . ,(oref post number))))) - -;;; Mode - -(defvar-keymap forge-post-mode-map - "C-c C-e" #'forge-post-dispatch - "C-c C-c" #'forge-post-submit - " " #'forge-post-submit - " " #'forge-post-submit - "C-c C-k" #'forge-post-cancel - " " #'forge-post-cancel - " " #'forge-post-cancel - " " #'forge-post-cancel - " " #'forge-post-cancel) - -(define-derived-mode forge-post-mode gfm-mode "Forge-Post" - "Major mode for editing topic posts." - :interactive nil) - -(defvar-local forge--buffer-base-branch nil) -(defvar-local forge--buffer-head-branch nil) -(defvar-local forge--buffer-post-object nil) -(defvar-local forge--buffer-issue nil) -(defvar-local forge--submit-post-function nil) -(defvar-local forge--cancel-post-function nil) -(defvar-local forge--pre-post-buffer nil) -(make-variable-buffer-local 'forge-buffer-draft-p) - -(defun forge--prepare-post-buffer (filename &optional header source target template) - (let* ((repo (forge-get-repository :tracked)) - (tree (oref repo worktree)) - (file (convert-standard-filename - (if tree - (expand-file-name (concat "magit/posts/" filename) - (magit-gitdir tree)) - (expand-file-name (format "%s_%s-%s_%s" - (oref repo githost) - (oref repo owner) - (oref repo name) - filename) - forge-post-fallback-directory))))) - (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) template) - (let-alist template - (cond - (.name - ;; A Github issue with yaml frontmatter. - (save-excursion (insert .text)) - (unless (re-search-forward "^title: " nil t) - (when (re-search-forward "^---" nil t 2) - (beginning-of-line) - (insert "title: \n") - (backward-char)))) - (t - (insert "# ") - (let ((single - (and source - (= (car (magit-rev-diff-count source target)) 1)))) - (save-excursion - (when single - ;; A pull-request. - (magit-rev-insert-format "%B" source)) - (when .text - (if single - (insert "-------\n") - (insert "\n")) - (insert "\n" .text))))))))) - buf))) - -(defun forge--display-post-buffer (buf) - (magit-display-buffer buf #'display-buffer)) - -(defun forge-post-cancel () - "Cancel the post that is being edited in the current buffer." - (interactive) - (save-buffer) - (if-let ((fn forge--cancel-post-function)) - (funcall fn forge--buffer-post-object) - (magit-mode-bury-buffer 'kill))) - -(defun forge-post-submit () - "Submit the post that is being edited in the current buffer." - (interactive) - (save-buffer) - (if-let ((fn forge--submit-post-function)) - (funcall fn - (forge-get-repository forge--buffer-post-object) - forge--buffer-post-object) - (error "forge--submit-post-function is nil"))) - -(defun forge--post-submit-callback () - (let* ((file buffer-file-name) - (editbuf (current-buffer)) - (prevbuf forge--pre-post-buffer) - (topic (ignore-errors (forge-get-topic forge--buffer-post-object))) - (repo (forge-get-repository topic))) - (lambda (value &optional headers status req) - (run-hook-with-args 'forge-post-submit-callback-hook - value headers status req) - (delete-file file t) - (let ((dir (file-name-directory file))) - (unless (cddr (directory-files dir nil nil t)) - (delete-directory dir nil t))) - (when (buffer-live-p editbuf) - (with-current-buffer editbuf - (magit-mode-bury-buffer 'kill))) - (with-current-buffer - (if (buffer-live-p prevbuf) prevbuf (current-buffer)) - (if (and topic - (forge--childp repo 'forge-github-repository) - (oref repo selective-p)) - (forge--pull-topic repo topic) - (forge-pull)))))) - -(defun forge--post-submit-errorback () - (lambda (error &rest _) - (error "Failed to submit post: %S" error))) - -(transient-define-prefix forge-post-dispatch () - "Dispatch a post creation command." - ["Variables" - ("d" "Create draft" forge-post-toggle-draft)] - ["Act" - ("C-c" "Submit" forge-post-submit) - ("C-k" "Cancel" forge-post-cancel)]) - -(transient-define-infix forge-post-toggle-draft () - "Toggle whether the pull-request being created is a draft." - :class 'transient-lisp-variable - :variable 'forge-buffer-draft-p - :reader (lambda (&rest _) (not forge-buffer-draft-p)) - :if (##equal (file-name-nondirectory buffer-file-name) "new-pullreq")) - -;;; Notes - -(defclass forge-note (forge-post) ()) - -(defvar-keymap forge-note-section-map - " " #'forge-edit-topic-note) - -(defun forge--save-note (_repo topic) - (let ((value (string-trim (magit--buffer-string)))) - (oset topic note (if (equal value "") nil value))) - (delete-file buffer-file-name t) - (let ((dir (file-name-directory buffer-file-name))) - (unless (cddr (directory-files dir nil nil t)) - (delete-directory dir))) - (let ((prevbuf forge--pre-post-buffer)) - (magit-mode-bury-buffer 'kill) - (forge-refresh-buffer prevbuf))) - -;;; _ -;; Local Variables: -;; read-symbol-shorthands: ( -;; ("partial" . "llama--left-apply-partially") -;; ("rpartial" . "llama--right-apply-partially")) -;; End: -(provide 'forge-post) -;;; forge-post.el ends here diff --git a/elpa/forge-20250516.1009/.dir-locals.el b/elpa/forge-20251201.1658/.dir-locals.el similarity index 100% rename from elpa/forge-20250516.1009/.dir-locals.el rename to elpa/forge-20251201.1658/.dir-locals.el diff --git a/elpa/forge-20250516.1009/dir b/elpa/forge-20251201.1658/dir similarity index 100% rename from elpa/forge-20250516.1009/dir rename to elpa/forge-20251201.1658/dir diff --git a/elpa/forge-20250516.1009/forge-autoloads.el b/elpa/forge-20251201.1658/forge-autoloads.el similarity index 95% rename from elpa/forge-20250516.1009/forge-autoloads.el rename to elpa/forge-20251201.1658/forge-autoloads.el index 15c11cb8..54532a48 100644 --- a/elpa/forge-20250516.1009/forge-autoloads.el +++ b/elpa/forge-20251201.1658/forge-autoloads.el @@ -27,6 +27,11 @@ is loaded, then `magit-mode-map' ends up being modified anyway.") (register-definition-prefixes "forge-bitbucket" '("forge-bitbucket-repository")) + +;;; Generated autoloads from forge-client.el + +(register-definition-prefixes "forge-client" '("forge--" "ghub--prepare-mutation")) + ;;; Generated autoloads from forge-commands.el @@ -94,6 +99,10 @@ jumping to a line, always use a commit hash as part of the URL. From a file in the worktree with no active region, instead use the branch name as part of the URL, unless a prefix argument is used. +When invoked from a Dired buffer, visit the blob at point without +prompting. If a prefix argument is used, the commit hash is included +in the URL. + When invoked from any other buffer, prompt the user for a branch or commit, and for a file. @@ -133,6 +142,10 @@ prefix argument offer all topics. While completion is in progress, \\\\[forge-read-topic-lift-limit] lifts the limitation to active pull-requests. (fn PULL-REQUEST)" t) +(autoload 'forge-visit-topic-from-url "forge-commands" "\ +Visit the topic specified by web URL. + +(fn URL)" t) (autoload 'forge-visit-this-topic "forge-commands" "\ Visit the topic at point. With prefix argument MENU, also show the topic menu. @@ -158,12 +171,17 @@ creates a new worktree. Please see the manual for more information. (fn PATH PULLREQ)" t) +(autoload 'forge-push-to-unnamed-pullreq "forge-commands" nil 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) +With prefix argument ALL, fork all branches, not just the default +branch. On Gitlab it is not possible to fork only the default. + +(fn FORK REMOTE ALL)" t) (autoload 'forge-merge "forge-commands" nil t) (autoload 'forge-set-default-branch "forge-commands" "\ Change the default branch on the upstream remote and locally. diff --git a/elpa/forge-20250516.1009/forge-bitbucket.el b/elpa/forge-20251201.1658/forge-bitbucket.el similarity index 99% rename from elpa/forge-20250516.1009/forge-bitbucket.el rename to elpa/forge-20251201.1658/forge-bitbucket.el index 859d0579..86959920 100644 --- a/elpa/forge-20250516.1009/forge-bitbucket.el +++ b/elpa/forge-20251201.1658/forge-bitbucket.el @@ -22,7 +22,6 @@ ;;; Code: -(require 'buck) (require 'forge) ;;; Class diff --git a/elpa/forge-20251201.1658/forge-client.el b/elpa/forge-20251201.1658/forge-client.el new file mode 100644 index 00000000..5a874b83 --- /dev/null +++ b/elpa/forge-20251201.1658/forge-client.el @@ -0,0 +1,159 @@ +;;; forge-client.el --- GraphQL and REST support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2025 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . + +;;; Code: + +(require 'forge) + +;;; GraphQL + +(cl-defun forge--query ( obj-or-host query variables + &key callback errorback noerror narrow until) + (declare (indent defun)) + (pcase-let ((`(,host ,forge) (forge--host-arguments obj-or-host))) + (ghub-query query variables + :auth 'forge :host host :forge forge + :callback callback :errorback errorback :noerror noerror + :narrow narrow :until until))) + +(cl-defmacro forge-query ( obj-or-host query variables + &key callback errorback noerror narrow until) + (declare (indent defun)) + `(forge--query ,obj-or-host + '(query ,query) + ,(forge--prepare-variables variables) + :callback ,callback :errorback ,errorback :noerror ,noerror + :narrow ,narrow :until ,until)) + +(cl-defmacro forge-mutate ( obj-or-host mutation variables + &key callback errorback noerror) + (declare (indent defun)) + `(forge--query ,obj-or-host + ',(ghub--prepare-mutation mutation) + (list (cons 'input ,(forge--prepare-variables variables))) + :callback ,callback :errorback ,errorback :noerror ,noerror)) + +(cl-defmacro forge--mutate-field (topic mutation variables) + (declare (indent defun)) + `(let ((topic ,topic)) + (forge--query topic + ',(ghub--prepare-mutation mutation) + (list (cons 'input ,(forge--prepare-variables variables))) + :callback (forge--set-field-callback topic)))) + +;;; REST + +(cl-defun forge--rest ( obj-or-host method resource &optional params + &key callback errorback noerror unpaginate) + (declare (indent defun)) + (pcase-let ((`(,host ,forge) (forge--host-arguments obj-or-host))) + (ghub-request method + (if (cl-typep obj-or-host 'forge-object) + (forge--format-resource obj-or-host resource) + resource) + params + :auth 'forge :host host :forge forge + :callback callback :errorback errorback :noerror noerror + :unpaginate unpaginate))) + +(cl-defmacro forge-rest ( obj-or-host method resource &optional params + &key callback errorback noerror unpaginate) + (declare (indent defun)) + `(forge--rest ,obj-or-host ,method ,resource + ,(forge--prepare-variables params) + :callback ,callback :errorback ,errorback :noerror ,noerror + :unpaginate ,unpaginate)) + +;;; Internal + +(defun forge--host-arguments (obj-or-host) + (let* ((repo (and (cl-typep obj-or-host 'forge-object) + (forge-get-repository obj-or-host))) + (host (if (stringp obj-or-host) + obj-or-host + (oref repo apihost)))) + (list host (pcase (if repo + (eieio-object-class-name repo) + (nth 3 (cl-find host forge-alist + :key #'cadr :test #'equal))) + ('forge-github-repository 'github) + ('forge-gitlab-repository 'gitlab) + (_ 'github))))) + +(defun ghub--prepare-mutation (mutation &optional var) + `(mutation + (,mutation + [(input ,(if var (intern (format "$%s" var)) '$input) + ,(let ((name (symbol-name mutation))) + (intern (format "%s%sInput!" + (upcase (substring name 0 1)) + (substring name 1)))))] + ;; We ignore the payload, but GraphQL requires that at least one + ;; field is specified. On Github this field is available for all + ;; mutations. On Gitlab there is no field that is available for + ;; all mutations, but luckily using an invalid fields does not + ;; result in an error. + clientMutationId))) + +(defun forge--prepare-variables (variables) + `(delq nil (list ,@(mapcar (lambda (binding) + (pcase-exhaustive binding + (`(,var ,val) + `(cons ',var ,val)) + (`(and ,cond (,var ,val)) + `(and ,cond (cons ',var ,val))))) + variables)))) + +(defun forge--set-field-callback (topic) + (let ((repo (forge-get-repository topic))) + (cond + ((forge-gitlab-repository--eieio-childp repo) + ;; TODO Fetch single topic for Gitlab as well. + (lambda (&rest _) + (forge--pull repo #'forge-refresh-buffer))) + ((forge-discussion--eieio-childp topic) + ;; See comment in `forge--update-status'. + (let ((status (oref topic status))) + (lambda (&rest _) + (forge--query repo + (ghub--graphql-prepare-query + forge--github-repository-query + `(repository discussions (discussion . ,(oref topic number)))) + `((owner . ,(oref repo owner)) + (name . ,(oref repo name))) + :callback (lambda (data) + (forge--update-discussion repo (cdr (cadr (cadr data)))) + (oset topic status status) + (forge-refresh-buffer)))))) + ((lambda (&rest _) + (forge--pull-topic (forge-get-repository topic) topic)))))) + +;;; _ +;; Local Variables: +;; read-symbol-shorthands: ( +;; ("and$" . "cond-let--and$") +;; ("and-let" . "cond-let--and-let") +;; ("if-let" . "cond-let--if-let") +;; ("when-let" . "cond-let--when-let")) +;; End: +(provide 'forge-client) +;;; forge-client.el ends here diff --git a/elpa/forge-20250516.1009/forge-commands.el b/elpa/forge-20251201.1658/forge-commands.el similarity index 85% rename from elpa/forge-20250516.1009/forge-commands.el rename to elpa/forge-20251201.1658/forge-commands.el index 02c2cbc6..e411e6c5 100644 --- a/elpa/forge-20250516.1009/forge-commands.el +++ b/elpa/forge-20251201.1658/forge-commands.el @@ -77,19 +77,22 @@ Takes the pull-request as only argument and must return a directory." ((or (magit-gitdir) (forge-repository-at-point)) "Forge does not yet track this repository") ("Not inside a Git repository"))) - ("/a" forge-add-repository + ("/ a" forge-add-repository :description (lambda () (let ((repo (forge-get-repository :stub?))) (if (or (not repo) (eq (oref repo condition) :tracked)) "track some repo" "track this repository")))) - ("/M" "merge with api" forge-merge + ("c f" "fork this repository" forge-fork + :if-not (##forge-get-repository :tracked?)) + ("/ M" "merge with api" forge-merge :if (##forge-get-repository :tracked?) :level 7)]] [forge--lists-group ["Visit" :inapt-if-not (##forge-get-repository :tracked?) ("v t" "topic" forge-visit-topic) + ("v u" "topic from url" forge-visit-topic-from-url :level 0) ("v d" "discussion" forge-visit-discussion) ("v i" "issue" forge-visit-issue) ("v p" "pull-request" forge-visit-pullreq)] @@ -144,7 +147,6 @@ repository cannot be determined, instead invoke `forge-add-repository'." (if (forge-get-repository :tracked?) "forge topics" "new forge repository")) - (declare (interactive-only nil)) (interactive) (if-let ((repo (forge-get-repository :tracked?))) (forge--pull repo) @@ -173,17 +175,18 @@ repository cannot be determined, instead invoke `forge-add-repository'." (magit-git-fetch (oref repo remote) (magit-fetch-arguments))) (defun forge--maybe-git-fetch (repo &optional buffer) - (if (buffer-live-p buffer) - (with-current-buffer buffer - (if (and (derived-mode-p 'magit-mode) - (forge-repository-equal (forge-get-repository :stub?) repo) - (magit-toplevel)) - (magit-git-fetch (oref repo remote) (magit-fetch-arguments)) - (magit-refresh-buffer))) - (when-let ((worktree (forge-get-worktree repo))) - (let ((default-directory worktree) - (magit-inhibit-refresh t)) - (magit-git-fetch (oref repo remote) (magit-fetch-arguments)))))) + (cond-let + ((buffer-live-p buffer) + (with-current-buffer buffer + (if (and (derived-mode-p 'magit-mode) + (forge-repository-equal (forge-get-repository :stub?) repo) + (magit-toplevel)) + (magit-git-fetch (oref repo remote) (magit-fetch-arguments)) + (magit-refresh-buffer)))) + ([worktree (forge-get-worktree repo)] + (let ((default-directory worktree) + (magit-inhibit-refresh t)) + (magit-git-fetch (oref repo remote) (magit-fetch-arguments)))))) ;;;###autoload(autoload 'forge-pull-notifications "forge-commands" nil t) (transient-define-suffix forge-pull-notifications () @@ -205,8 +208,7 @@ repository cannot be determined, instead invoke `forge-add-repository'." (forge--get-github-repository))) (interactive (list (read-number "Pull topic: " - (and-let* ((topic (forge-current-topic))) - (oref topic number))))) + (and$ (forge-current-topic) (oref $ number))))) (forge--pull-topic (forge-get-repository :tracked) number)) ;;;###autoload(autoload 'forge-pull-this-topic "forge-commands" nil t) @@ -324,6 +326,10 @@ jumping to a line, always use a commit hash as part of the URL. From a file in the worktree with no active region, instead use the branch name as part of the URL, unless a prefix argument is used. +When invoked from a Dired buffer, visit the blob at point without +prompting. If a prefix argument is used, the commit hash is included +in the URL. + When invoked from any other buffer, prompt the user for a branch or commit, and for a file." (interactive (forge--browse-blob-args)) @@ -365,19 +371,16 @@ commit, and for a file." (user-error "Nothing to browse here"))) (defun forge--browse-target () - (or (and-let* ((branch (magit--painted-branch-at-point))) - (forge-get-url :branch branch)) - (and-let* ((commit (magit-commit-at-point))) - (forge-get-url :commit commit)) - (and-let* ((branch (magit-branch-at-point))) - (forge-get-url :branch branch)) - (and-let* ((remote (magit-remote-at-point))) - (forge-get-url :remote remote)) - (and-let* ((file (magit-file-at-point))) - (forge-get-url :blob nil file)) + (or (and$ (magit--painted-branch-at-point) (forge-get-url :branch $)) + (and$ (magit-commit-at-point) (forge-get-url :commit $)) + (and$ (magit-branch-at-point) (forge-get-url :branch $)) + (and$ (magit-remote-at-point) (forge-get-url :remote $)) + (and$ (magit-file-at-point) (forge-get-url :blob nil $)) (forge-post-at-point) (forge-current-topic) - (and (or magit-buffer-file-name buffer-file-name) + (and (or magit-buffer-file-name + buffer-file-name + (derived-mode-p 'dired-mode)) (apply #'forge-get-url :blob (forge--browse-blob-args))) (and magit-buffer-revision (forge-get-url :commit magit-buffer-revision)) @@ -395,6 +398,10 @@ commit, and for a file." ,(magit-file-relative-name buffer-file-name) ,@(magit-file-region-line-numbers) ,current-prefix-arg)) + ((derived-mode-p 'dired-mode) + `(nil + ,(magit-file-relative-name (dired-get-filename)) + ,current-prefix-arg)) ((let ((commit (magit-read-local-branch-or-commit "Browse file from commit"))) (list commit (magit-read-file-from-rev commit "Browse file")))))) @@ -418,13 +425,14 @@ commit, and for a file." (cl-defmethod forge-get-url ((_(eql :commit)) commit) (let ((repo (forge-get-repository :stub))) - (unless (magit-list-containing-branches - commit "-r" (concat (oref repo remote) "/*")) - (if-let* ((branch (car (magit-list-containing-branches commit "-r"))) - (remote (car (magit-split-branch-name branch)))) - (setq repo (forge-get-repository :stub remote)) - (message "%s does not appear to be available on any remote. %s" - commit "You might have to push it first."))) + (cond-let* + ((magit-list-containing-branches + commit "-r" (concat (oref repo remote) "/*"))) + ([branch (car (magit-list-containing-branches commit "-r"))] + [remote (car (magit-split-branch-name branch))] + (setq repo (forge-get-repository :stub remote))) + ((message "%s does not appear to be available on any remote. %s" + commit "You might have to push it first."))) (forge--format repo 'commit-url-format `((?r . ,(magit-commit-p commit)))))) @@ -537,6 +545,20 @@ lifts the limitation to active pull-requests." (interactive (list (forge-read-pullreq "View pull-request"))) (forge-topic-setup-buffer (forge-get-pullreq pull-request))) +;;;###autoload +(defun forge-visit-topic-from-url (url) + "Visit the topic specified by web URL." + (interactive (list (read-string "Topic URL: "))) + (if (string-match + "/\\(issues\\|pull\\|discussions\\|merge_requests\\)/\\([0-9]+\\)\\'" + url) + (forge-topic-setup-buffer + (forge-get-topic (forge-get-repository + (substring url 0 (match-beginning 1)) + nil :tracked) + (string-to-number (match-string 2 url)))) + (user-error "Not recognized as a topic URL: %s" url))) + ;;;###autoload (defun forge-visit-this-topic (&optional menu) "Visit the topic at point. @@ -560,10 +582,11 @@ With prefix argument MENU, also show the topic menu." (cond ((and (eq transient-current-command 'forge-repositories-menu) (forge-get-repository repo nil :tracked?)) - (if-let ((buffer (get-buffer (forge-topics-buffer-name repo)))) - (progn (switch-to-buffer buffer) - (transient-setup 'forge-topics-menu)) - (forge-list-topics repo))) + (cond-let + ([buffer (get-buffer (forge-topics-buffer-name repo))] + (switch-to-buffer buffer) + (transient-setup 'forge-topics-menu)) + ((forge-list-topics repo)))) (worktree (magit-status-setup-buffer worktree)) ((forge-get-repository repo nil :tracked?) @@ -576,52 +599,30 @@ With prefix argument MENU, also show the topic menu." "Create a new discussion for the current repository." (interactive (list (forge-read-topic-category nil "Category for new discussion"))) - (let* ((repo (forge-get-repository :tracked)) - (buf (forge--prepare-post-buffer - "new-discussion" - (forge--format repo "Create new discussion on %p")))) - (when buf - (with-current-buffer buf - (setq forge--buffer-post-object repo) - (setq forge--submit-post-function - (rpartial #'forge--submit-create-discussion category))) - (forge--display-post-buffer buf)))) - -(defun forge-create-issue () + (forge--setup-post-buffer 'new-discussion #'forge--submit-create-discussion + "new-discussion" "Create new discussion on %p" + `((forge--buffer-category ,category)))) + +(defun forge-create-issue (template) "Create a new issue for the current repository." - (interactive) - (let* ((repo (forge-get-repository :tracked)) - (template (forge--topic-template repo 'forge-issue))) - (let-alist template - (pcase-exhaustive .type - ('redirect (browse-url .url)) - ('forge-discussion (forge-create-discussion .category)) - ('forge-issue - (when-let ((buf (forge--prepare-post-buffer - "new-issue" - (forge--format repo "Create new issue on %p") - nil nil template))) - (with-current-buffer buf - (setq forge--buffer-post-object repo) - (setq forge--submit-post-function #'forge--submit-create-issue)) - (forge--display-post-buffer buf))))))) + (interactive (list (forge--topic-template nil 'forge-issue))) + (let-alist template + (pcase-exhaustive .type + ('redirect (browse-url .url)) + ('forge-discussion (forge-create-discussion .category)) + ('forge-issue + (forge--setup-post-buffer 'new-issue #'forge--submit-create-issue + "new-issue" "Create new issue on %p" + `((forge--buffer-template ,template))))))) (defun forge-create-pullreq (source target) "Create a new pull-request for the current repository." (interactive (forge-create-pullreq--read-args)) - (let* ((repo (forge-get-repository :tracked)) - (buf (forge--prepare-post-buffer - "new-pullreq" - (forge--format repo "Create new pull-request on %p") - source target - (forge--topic-template repo 'forge-pullreq)))) - (with-current-buffer buf - (setq forge--buffer-base-branch target) - (setq forge--buffer-head-branch source) - (setq forge--buffer-post-object repo) - (setq forge--submit-post-function #'forge--submit-create-pullreq) - (run-hooks 'forge-create-pullreq-hook)) - (forge--display-post-buffer buf))) + (forge--setup-post-buffer 'new-pullreq #'forge--submit-create-pullreq + "new-pullreq" "Create new pull-request on %p" + `((forge--buffer-base-branch ,target) + (forge--buffer-head-branch ,source) + (forge--buffer-template ,(forge--topic-template nil 'forge-pullreq))))) (transient-define-suffix forge-create-pullreq-from-issue (issue source target) "Convert an existing ISSUE into a pull-request." @@ -645,11 +646,11 @@ With prefix argument MENU, also show the topic menu." "Source branch" (magit-list-remote-branch-names) nil t nil 'magit-revision-history - (or (and-let* ((d (magit-branch-at-point))) + (or (and-let ((d (magit-branch-at-point))) (if (magit-remote-branch-p d) d (magit-get-push-branch d t))) - (and-let* ((d (magit-get-current-branch))) + (and-let ((d (magit-get-current-branch))) (if (magit-remote-branch-p d) d (magit-get-push-branch d t)))))) @@ -680,35 +681,30 @@ point is currently on." (let* ((quote (cond ((not (magit-section-match 'post)) nil) ((use-region-p) - (magit--buffer-string (region-beginning) (region-end))) + (buffer-str (region-beginning) (region-end))) (quote (with-slots (content end) (magit-current-section) - (magit--buffer-string content end t))))) + (string-trim (buffer-str content end)))))) + (quote (and quote + (lambda () + (goto-char (point-max)) + (unless (bobp) + (insert "\n")) + (insert (replace-regexp-in-string "^" "> " quote)) + (insert "\n\n")))) (obj (if (forge-discussion-p forge-buffer-topic) (forge--select-discussion-reply-target) - forge-buffer-topic)) - (buf (cond - ((forge-discussion-post-p obj) - (forge--prepare-post-buffer - (forge--format obj "%i;%I;new-reply") - (forge--format obj "New comment on #%i;%I of %p"))) - ((forge-discussion-p obj) - (forge--prepare-post-buffer - (forge--format obj "%i;new-answer") - (forge--format obj "New comment on #%i of %p"))) - (t - (forge--prepare-post-buffer - (forge--format obj "%i;new-comment") - (forge--format obj "New comment on #%i of %p")))))) - (with-current-buffer buf - (setq forge--buffer-post-object obj) - (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))) + forge-buffer-topic))) + (cl-typecase obj + (forge-discussion-post + (forge--setup-post-buffer obj #'forge--submit-create-post + "%i;%I;new-reply" "New comment on #%i;%I of %p" nil quote)) + (forge-discussion + (forge--setup-post-buffer obj #'forge--submit-create-post + "%i;new-answer" "New comment on #%i of %p" nil quote)) + (t + (forge--setup-post-buffer obj #'forge--submit-create-post + "%i;new-comment" "New comment on #%i of %p" nil quote))))) (transient-define-suffix forge-approve-pullreq () "Approve the current pull-request." @@ -717,15 +713,10 @@ point is currently on." :transient nil (interactive) (let ((pullreq (forge-current-pullreq t))) - (unless (cl-typep (forge-get-repository pullreq) 'forge-github-repository) + (unless (forge-github-repository-p (forge-get-repository pullreq)) (user-error "This command is only available for Github")) - (when-let ((buf (forge--prepare-post-buffer - (forge--format pullreq "%i;new-approval") - (forge--format pullreq "Approve pull-request #%i of %p")))) - (with-current-buffer buf - (setq forge--buffer-post-object pullreq) - (setq forge--submit-post-function #'forge--submit-approve-pullreq)) - (forge--display-post-buffer buf)))) + (forge--setup-post-buffer pullreq #'forge--submit-approve-pullreq + "%i;new-approval" "Approve pull-request #%i of %p"))) (transient-define-suffix forge-request-changes () "Request changes to the current pull-request." @@ -734,40 +725,29 @@ point is currently on." :transient nil (interactive) (let ((pullreq (forge-current-pullreq t))) - (unless (cl-typep (forge-get-repository pullreq) 'forge-github-repository) + (unless (forge-github-repository-p (forge-get-repository pullreq)) (user-error "This command is only available for Github")) - (when-let ((buf (forge--prepare-post-buffer - (forge--format pullreq "%i;new-request") - (forge--format - pullreq "Request changes for pull-request #%i of %p")))) - (with-current-buffer buf - (setq forge--buffer-post-object pullreq) - (setq forge--submit-post-function #'forge--submit-request-changes)) - (forge--display-post-buffer buf)))) + (forge--setup-post-buffer pullreq #'forge--submit-request-changes + "%i;new-request" "Request changes for pull-request #%i of %p"))) ;;; Edit (defun forge-edit-post () "Edit the current post." (interactive) - (let* ((post (forge-post-at-point t)) - (buf (cl-typecase post - (forge-topic - (forge--prepare-post-buffer - (forge--format post "%i") - (forge--format post "Edit #%i of %p"))) - (forge-post - (forge--prepare-post-buffer - (forge--format post "%i;%I") - (forge--format post "Edit comment on #%i of %p")))))) - (with-current-buffer buf - (setq forge--buffer-post-object post) - (setq forge--submit-post-function #'forge--submit-edit-post) - (erase-buffer) - (when (cl-typep post 'forge-topic) - (insert "# " (oref post title) "\n\n")) - (insert (oref post body))) - (forge--display-post-buffer buf))) + (let ((post (forge-post-at-point t))) + (cl-typecase post + (forge-topic + (forge--setup-post-buffer post #'forge--submit-edit-post + "%i" "Edit #%i of %p" nil + (lambda () + (insert "# " (oref post title) "\n\n") + (insert (oref post body))))) + (forge-post + (forge--setup-post-buffer post #'forge--submit-edit-post + "%i;%I" "Edit comment on #%i of %p" nil + (lambda () + (insert (oref post body)))))))) (transient-define-suffix forge-edit-topic-note () "Edit your private note about the current topic." @@ -785,18 +765,12 @@ point is currently on." (interactive) (if-let* ((topic (forge-current-topic t)) (repo (forge-get-repository topic)) - (default-directory (forge-get-worktree repo)) - (buf (forge--prepare-post-buffer - (forge--format topic "%i;note") - (forge--format topic "New note on #%i of %p")))) - (progn - (with-current-buffer buf - (setq forge--buffer-post-object topic) - (setq forge--submit-post-function #'forge--save-note) - (erase-buffer) + (default-directory (forge-get-worktree repo))) + (forge--setup-post-buffer topic #'forge--save-note + "%i;note" "New note on #%i of %p" nil + (lambda () (when-let ((note (oref topic note))) - (save-excursion (insert note ?\n)))) - (forge--display-post-buffer buf)) + (save-excursion (insert note ?\n))))) (message "Cannot determine topic or worktree"))) ;;; Delete @@ -819,8 +793,8 @@ Please see the manual for more information." (interactive (list (forge-read-pullreq "Branch pull request"))) (let ((pullreq (forge-get-pullreq pullreq))) (if-let ((branch (forge--pullreq-branch-active pullreq))) - (progn (message "Branch %S already exists and is configured" branch) - branch) + (prog1 branch + (message "Branch %S already exists and is configured" branch)) (forge--branch-pullreq pullreq) (forge-refresh-buffer)))) @@ -844,7 +818,7 @@ Please see the manual for more information." (branch-n (format "pr-%s" number)) (branch (or (forge--pullreq-branch-internal pullreq) branch-n)) (pullreq-ref (format "refs/pullreqs/%s" number))) - (cond ((and-let* ((pr-branch (oref pullreq head-ref))) + (cond ((and-let ((pr-branch (oref pullreq head-ref))) (string-search ":" pr-branch)) ;; Such a branch name would be invalid. If we encounter ;; it anyway, then that means that the source branch and @@ -852,7 +826,7 @@ Please see the manual for more information." ;; longer does this, but we nevertheless have to deal ;; with merge-requests that have been lost in time. (error "Cannot check out this merge-request because %s" - "on old Gitlab version discarded the source branch")) + "an old Gitlab version discarded the source branch")) ((not (eq (oref pullreq state) 'open)) (magit-git "branch" "--force" branch pullreq-ref)) (t @@ -998,6 +972,44 @@ information." (user-error "The empty string isn't a valid path")) path)) +;;;###autoload(autoload 'forge-push-to-unnamed-pullreq "forge-commands" nil t) +(transient-define-suffix forge-push-to-unnamed-pullreq (args) + "Push the current branch to the branch on the contributor's fork. + +Usually a maintainer would use `magit-push-current-to-pushremote' to +push to the branch, the contributor asks to be merged. That does not +work if they did not create a dedicated branch and instead committed +directly to \"main\", or some other branch, that also exists in the +upstream repository. + +If this is the case then the branch, which is used to check out the +pull-request locally, is named \"pr-N\" (where N is the pull-request +number) and this command is made available as a substitute in the +`magit-push' menu." + :if (lambda () + (and-let ((branch (magit-get-current-branch))) + (and (forge-get-pullreq :branch branch) + (string-match-p "\\`pr-[0-9]+\\'" branch)))) + :description (lambda () + (and-let* ((branch (magit-get-current-branch)) + (pullreq (forge-get-pullreq :branch branch))) + (format "contributor's %s branch" + (magit--propertize-face + (format "%s/%s" + (oref pullreq head-user) + (oref pullreq head-ref)) + 'magit-branch-remote)))) + (interactive (list (magit-push-arguments))) + (cond-let* + ([branch (magit-get-current-branch)] + [pullreq (forge-get-pullreq :branch branch)] + (run-hooks 'magit-credential-hook) + (magit-run-git-async "push" "-v" + (delete "--tags" (delete "--follow-tags" args)) + (oref pullreq head-user) + (format "%s:%s" branch (oref pullreq head-ref)))) + ((error "Checked out branch is not an unnamed pull-request branch")))) + ;;; Marks (defun forge-create-mark (name face description) @@ -1047,10 +1059,14 @@ information." ;;; Remotely ;;;###autoload -(defun forge-fork (fork remote) +(defun forge-fork (fork remote all) "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." +is added anyway. Currently this only supports Github and Gitlab. + +With prefix argument ALL, fork all branches, not just the default +branch. On Gitlab it is not possible to fork only the default." (interactive (let ((fork (magit-completing-read "Fork to" (mapcar #'car forge-owned-accounts)))) @@ -1058,9 +1074,10 @@ is added anyway. Currently this only supports Github and Gitlab." (read-string "Remote name: " (or (plist-get (cdr (assoc fork forge-owned-accounts)) 'remote-name) - fork))))) + fork)) + current-prefix-arg))) (let ((repo (forge-get-repository :stub))) - (forge--fork-repository repo fork) + (forge--fork-repository repo fork all) (magit-remote-add remote (magit-clone--format-url (oref repo githost) fork (oref repo name)) @@ -1315,15 +1332,15 @@ upstream remote." :scope (forge-add-repository--scope repo))) (t (when-let* - (((not (eq limit :selective))) - ((magit-git-config-p "forge.autoPull" t)) + ((_(not (eq limit :selective))) + (_(magit-git-config-p "forge.autoPull" t)) (remote (oref repo remote)) (refspec (oref repo pullreq-refspec)) (default-directory (forge-get-worktree repo)) - ((and (not (member refspec (magit-get-all "remote" remote "fetch"))) - (or (eq forge-add-pullreq-refspec t) - (and (eq forge-add-pullreq-refspec 'ask) - (y-or-n-p (format "Also add %S refspec? " refspec))))))) + (_(and (not (member refspec (magit-get-all "remote" remote "fetch"))) + (or (eq forge-add-pullreq-refspec t) + (and (eq forge-add-pullreq-refspec 'ask) + (y-or-n-p (format "Also add %S refspec? " refspec))))))) (magit-call-git "config" "--add" (format "remote.%s.fetch" remote) refspec)) @@ -1429,9 +1446,9 @@ when that happens, because given how the APIs work, this would be too expensive." (interactive (list (if-let* ((topics (magit-region-values '(issue pullreq) t)) - ((magit-confirm 'remove-topics-locally nil - "Delete %d topics locally" nil - (mapcar #'forge--format-topic-line topics)))) + (_(magit-confirm 'remove-topics-locally nil + "Delete %d topics locally" nil + (mapcar #'forge--format-topic-line topics)))) topics (forge-read-topic "Delete topic LOCALLY only")))) (if (listp topic) @@ -1494,8 +1511,13 @@ context." ;;; _ ;; Local Variables: ;; read-symbol-shorthands: ( -;; ("partial" . "llama--left-apply-partially") -;; ("rpartial" . "llama--right-apply-partially")) +;; ("and$" . "cond-let--and$") +;; ("and-let" . "cond-let--and-let") +;; ("if-let" . "cond-let--if-let") +;; ("when-let" . "cond-let--when-let") +;; ("buffer-string" . "buffer-string") +;; ("buffer-str" . "forge--buffer-substring-no-properties") +;; ("partial" . "llama--left-apply-partially")) ;; End: (provide 'forge-commands) ;;; forge-commands.el ends here diff --git a/elpa/forge-20250516.1009/forge-core.el b/elpa/forge-20251201.1658/forge-core.el similarity index 80% rename from elpa/forge-20250516.1009/forge-core.el rename to elpa/forge-20251201.1658/forge-core.el index 5086adaf..fb6203be 100644 --- a/elpa/forge-20250516.1009/forge-core.el +++ b/elpa/forge-20251201.1658/forge-core.el @@ -26,6 +26,7 @@ (require 'cl-lib) (require 'compat) +(require 'cond-let) (require 'eieio) (require 'llama) (require 'seq) @@ -33,16 +34,14 @@ (require 'transient) +(require 'ghub-graphql) (require 'forge-db) (eval-when-compile (cl-pushnew 'forge-id eieio--known-slot-names) - (cl-pushnew 'id eieio--known-slot-names) - (cl-pushnew 'name eieio--known-slot-names) (cl-pushnew 'number eieio--known-slot-names) (cl-pushnew 'owner eieio--known-slot-names) - (cl-pushnew 'their-id eieio--known-slot-names) - (cl-pushnew 'worktree eieio--known-slot-names)) + (cl-pushnew 'their-id eieio--known-slot-names)) ;;; Options @@ -59,6 +58,8 @@ '(;; Forges ("github.com" "api.github.com" "github.com" forge-github-repository) + ("ssh.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" @@ -267,7 +268,7 @@ is non-nil." "\\(?:\\.git\\|/\\)?" "\\'") url) - (and-let* ((elt (forge--get-forge-host (match-string 1 url) (not relax)))) + (and-let ((elt (forge--get-forge-host (match-string 1 url) (not relax)))) ;; Return the WEBHOST (not the GITHOST, URLs passed to this ;; function usually contain a GITHOST) because the IDs used to ;; identify a repository in the database are based on WEBHOSTs. @@ -291,16 +292,50 @@ is non-nil." &optional stub noerror) "Return the database and forge ids for the specified CLASS object.") -(defun forge--their-id (id/obj) - "Return the forge's id for the ID used in the local database." +(defun forge--their-id (arg &optional type repo) + "Return the forge's ID for ARG. +This deals with technical debt related to our handling of IDs." (cond - ((stringp id/obj) - (car (last (split-string (base64-decode-string id/obj) ":")))) - ((slot-exists-p id/obj 'their-id) - (oref id/obj their-id)) - ((slot-exists-p id/obj 'forge-id) - (oref id/obj forge-id)) - ((forge--their-id (oref id/obj id))))) + (type + (pcase type + ('assignee + (forge-sql1 [:select [forge-id] + :from assignee + :where (and (= repository $s1) + (= login $s2))] + (oref repo id) arg)) + ('assignees + (forge-sql-car [:select [forge-id] + :from assignee + :where (and (= repository $s1) + (in login $v2))] + (oref repo id) + (vconcat arg))) + ('category + (forge-sql1 [:select [their-id] + :from discussion-category + :where (and (= repository $s1) + (= name $s2))] + (oref repo id) arg)) + ('label + (forge--their-id + (forge-sql1 [:select [id] + :from label + :where (and (= repository $s1) + (= name $s2))] + (oref repo id) arg))) + ('labels + (mapcar (##forge--their-id % 'label repo) arg)) + ('milestone + (forge--their-id + (forge-sql1 [:select [id] :from milestone :where (= title $s1)] arg))))) + ((stringp arg) + (car (last (split-string (base64-decode-string arg) ":")))) + ((slot-exists-p arg 'their-id) + (oref arg their-id)) + ((slot-exists-p arg 'forge-id) + (oref arg forge-id)) + ((forge--their-id (oref arg id))))) (cl-defmethod magit-section-ident-value ((obj forge-object)) "Return the value ob OBJ's `id' slot. @@ -336,7 +371,7 @@ of SLOT.") (cl-defmethod forge--format-resource ((object forge-object) resource) "Return an API resource based on RESOURCE and slots of OBJECT. -For use in `forge--FORGE-METHOD' such as `forge--ghub-get'. +This is used by `forge--rest' and by extension `forge-rest'. RESOURCE is a string separated by slashes. Each part that begins with a colon is replaced with a value from OBJECT. `:repo' is a synonym for `:name'. `:project' is a like `:owner/:name', but the @@ -350,36 +385,39 @@ parent object (determined using `forge-get-parent')." ":\\([^/]+\\)" (lambda (str) (let ((slot (intern (substring str 1)))) - (or (and-let* - ((v (ignore-errors - (pcase slot - ('repo (oref object name)) - ('project (concat (string-replace - "/" "%2F" (oref object owner)) - "%2F" - (oref object name))) - ('topic (and (forge--childp object 'forge-topic) - (oref object number))) - (_ (eieio-oref object slot)))))) - (format "%s" v)) + (or (and$ (ignore-errors + (pcase slot + ('repo (oref object name)) + ('project (concat (string-replace + "/" "%2F" (oref object owner)) + "%2F" + (oref object name))) + ('topic (and (forge--childp object 'forge-topic) + (oref object number))) + (_ (eieio-oref object slot)))) + (format "%s" $)) 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))) + (cond-let + ((not (string-match ":[^/]*" resource)) + resource) + ([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)))))) ;;; Miscellaneous (defun forge-refresh-buffer (&optional buffer) "Refresh the current buffer, if it is a Magit or Forge buffer. + Refresh the buffer if its major-mode derives from `magit-mode' or `forge-repository-list-mode'. If optional BUFFER is non-nil, then refresh that buffer, provided it is alive and satisfies -the mode requirement." +the mode requirement. + +When certain Forge menus are active, refresh them too." (interactive) (cond (buffer (when (buffer-live-p buffer) @@ -394,12 +432,24 @@ the mode requirement." (oref forge--buffer-topics-spec global)) (revert-buffer)) ((derived-mode-p 'forge-repository-list-mode) - (revert-buffer)))) + (revert-buffer))) + (when (transient-active-prefix + '(forge-topic-menu + forge-topics-menu + forge-notifications-menu)) + (transient--refresh-transient))) (defun forge--sanitize-string (string) ;; For Gitlab this may also be nil. (if string (string-replace "\r\n" "\n" string) "")) +(defun forge--buffer-substring-no-properties (&optional start end) + "Like `buffer-substring-no-properties' but the arguments are optional. +Optional START defaults to the value of `point-min'. +Optional END defaults to the value of `point-max'." + (buffer-substring-no-properties (or start (point-min)) + (or end (point-max)))) + (defun forge--uuid () "Return string with random (version 4) UUID." ;; This is a copy of `org-id-uuid'. @@ -429,8 +479,10 @@ the mode requirement." ;;; _ ;; Local Variables: ;; read-symbol-shorthands: ( -;; ("partial" . "llama--left-apply-partially") -;; ("rpartial" . "llama--right-apply-partially")) +;; ("and$" . "cond-let--and$") +;; ("and-let" . "cond-let--and-let") +;; ("if-let" . "cond-let--if-let") +;; ("when-let" . "cond-let--when-let")) ;; End: (provide 'forge-core) ;;; forge-core.el ends here diff --git a/elpa/forge-20250516.1009/forge-db.el b/elpa/forge-20251201.1658/forge-db.el similarity index 96% rename from elpa/forge-20250516.1009/forge-db.el rename to elpa/forge-20251201.1658/forge-db.el index 5767240e..eae46b07 100644 --- a/elpa/forge-20250516.1009/forge-db.el +++ b/elpa/forge-20251201.1658/forge-db.el @@ -65,6 +65,9 @@ (emacsql (forge-db) (apply #'format sql args)) (apply #'emacsql (forge-db) sql args))) +(defun forge-sql1 (sql &rest args) + (caar (apply #'forge-sql sql args))) + (defun forge-sql-car (sql &rest args) (mapcar #'car (apply #'forge-sql sql args))) @@ -600,21 +603,21 @@ :where (isnull issues-until)])) (emacsql db [:update repository :set (= issues-until $s1) :where (= id $s2)] - (caar (forge-sql [:select [updated] :from issue - :where (= repository $s1) - :order-by [(desc updated)] - :limit 1] - id)) + (forge-sql1 [:select [updated] :from issue + :where (= repository $s1) + :order-by [(desc updated)] + :limit 1] + id) id)) (dolist (id (emacsql db [:select id :from repository :where (isnull pullreqs-until)])) (emacsql db [:update repository :set (= pullreqs-until $s1) :where (= id $s2)] - (caar (forge-sql [:select [updated] :from pullreq - :where (= repository $s1) - :order-by [(desc updated)] - :limit 1] - id)) + (forge-sql1 [:select [updated] :from pullreq + :where (= repository $s1) + :order-by [(desc updated)] + :limit 1] + id) id)) (emacsql db [:alter-table repository :rename-column sparse-p :to condition]) (pcase-dolist (`(,id ,not-tracked) @@ -661,8 +664,10 @@ ;;; _ ;; Local Variables: ;; read-symbol-shorthands: ( -;; ("partial" . "llama--left-apply-partially") -;; ("rpartial" . "llama--right-apply-partially")) +;; ("and$" . "cond-let--and$") +;; ("and-let" . "cond-let--and-let") +;; ("if-let" . "cond-let--if-let") +;; ("when-let" . "cond-let--when-let")) ;; End: (provide 'forge-db) ;;; forge-db.el ends here diff --git a/elpa/forge-20250516.1009/forge-discussion.el b/elpa/forge-20251201.1658/forge-discussion.el similarity index 83% rename from elpa/forge-20250516.1009/forge-discussion.el rename to elpa/forge-20251201.1658/forge-discussion.el index 25b4400c..4aa73211 100644 --- a/elpa/forge-20250516.1009/forge-discussion.el +++ b/elpa/forge-20251201.1658/forge-discussion.el @@ -106,20 +106,27 @@ (cl-defmethod forge-get-repository ((post forge-discussion-post)) (forge-get-repository (forge-get-discussion post))) +(cl-defmethod forge-get-repository ((post forge-discussion-reply)) + (forge-get-repository (forge-get-discussion post))) + (cl-defmethod forge-get-topic ((post forge-discussion-post)) (forge-get-discussion post)) +(cl-defmethod forge-get-topic ((post forge-discussion-reply)) + (forge-get-discussion post)) + (cl-defmethod forge-get-discussion ((disc forge-discussion)) disc) (cl-defmethod forge-get-discussion ((repo forge-repository) number) + (cl-assert (numberp number) t) (closql-get (forge-db) (forge--object-id 'forge-discussion repo number) 'forge-discussion)) (cl-defmethod forge-get-discussion ((number integer)) - (and-let* ((repo (forge-get-repository :tracked nil 'notatpt))) - (forge-get-discussion repo number))) + (and$ (forge-get-repository :tracked nil 'notatpt) + (forge-get-discussion $ number))) (cl-defmethod forge-get-discussion ((id string)) (closql-get (forge-db) id 'forge-discussion)) @@ -129,15 +136,10 @@ (oref post discussion) 'forge-discussion)) -;; (cl-defmethod forge-get-discussion ((post forge-discussion-reply)) -;; (closql-get (forge-db) -;; (oref post discussion) -;; 'forge-discussion)) - -;; (cl-defmethod forge-get-discussion-post ((reply forge-discussion-reply)) -;; (closql-get (forge-db) -;; (oref reply post) -;; 'forge-discussion-post)) +(cl-defmethod forge-get-discussion ((post forge-discussion-reply)) + (closql-get (forge-db) + (oref post discussion) + 'forge-discussion)) ;;;; Current @@ -171,9 +173,9 @@ an error." (put 'forge-discussion 'thing-at-point #'forge-thingatpt--discussion) (defun forge-thingatpt--discussion () - (and-let* (((thing-at-point-looking-at "#\\([0-9]+\\)\\_>")) - (number (string-to-number (match-string 1))) - (repo (forge--repo-for-thingatpt))) + (and-let ((_(thing-at-point-looking-at "#\\([0-9]+\\)\\_>")) + (number (string-to-number (match-string 1))) + (repo (forge--repo-for-thingatpt))) (forge-get-discussion repo number))) ;;; Read @@ -208,9 +210,9 @@ can be selected from the start." (if-let ((post (forge-post-at-point))) (cond ((forge-discussion-p (forge-post-at-point)) (user-error "Cannot pick the question as its own answer")) - ((and-let* ((answer (oref topic answer))) - (equal (oref post their-id) - (forge--their-id answer))) + ((and$ (oref topic answer) + (equal (oref post their-id) + (forge--their-id $))) nil) (post)) (user-error "Point must be on an reply to mark it as the answer"))) @@ -226,14 +228,17 @@ can be selected from the start." (substring text 0 (match-beginning 0)) text)) answer))))) + (new-answer (cons "Add new top-level answer" forge-buffer-topic)) (post (forge-post-at-point)) - (answer (if (forge-discussion-reply-p post) - (magit-section-parent-value - (magit-current-section)) - post)) - (default (and answer (funcall format-answer answer))) - (choices `(("Add new top-level answer" . ,forge-buffer-topic) - ,@(mapcar format-answer answers)))) + (default (cl-typecase post + (forge-discussion-reply + (funcall format-answer + (magit-section-parent-value + (magit-current-section)))) + (forge-discussion-post + (funcall format-answer post)) + (forge-discussion new-answer))) + (choices (cons new-answer (mapcar format-answer answers)))) (cdr (assoc (magit-completing-read "Reply to: " choices nil t nil nil default) choices))) @@ -258,11 +263,11 @@ can be selected from the start." "Insert a list of discussions, according to `forge--buffer-topics-spec'. Optional SPEC can be used to override that filtering specification, and optional HEADING to change the section heading." - (when-let (((forge-db t)) - (repo (forge-get-repository :tracked?)) - ((oref repo discussions-p)) - (spec (if sspec spec (forge--clone-buffer-topics-spec))) - ((memq (oref spec type) '(topic discussion)))) + (when-let* ((_(forge-db t)) + (repo (forge-get-repository :tracked?)) + (_(oref repo discussions-p)) + (spec (if sspec spec (forge--clone-buffer-topics-spec))) + (_(memq (oref spec type) '(topic discussion)))) (oset spec type 'discussion) (forge--insert-topics 'discussions (or heading "Discussions") @@ -271,8 +276,10 @@ and optional HEADING to change the section heading." ;;; _ ;; Local Variables: ;; read-symbol-shorthands: ( -;; ("partial" . "llama--left-apply-partially") -;; ("rpartial" . "llama--right-apply-partially")) +;; ("and$" . "cond-let--and$") +;; ("and-let" . "cond-let--and-let") +;; ("if-let" . "cond-let--if-let") +;; ("when-let" . "cond-let--when-let")) ;; End: (provide 'forge-discussion) ;;; forge-discussion.el ends here diff --git a/elpa/forge-20250516.1009/forge-forgejo.el b/elpa/forge-20251201.1658/forge-forgejo.el similarity index 100% rename from elpa/forge-20250516.1009/forge-forgejo.el rename to elpa/forge-20251201.1658/forge-forgejo.el diff --git a/elpa/forge-20250516.1009/forge-gitea.el b/elpa/forge-20251201.1658/forge-gitea.el similarity index 89% rename from elpa/forge-20250516.1009/forge-gitea.el rename to elpa/forge-20251201.1658/forge-gitea.el index d7a5c40d..eb7b976b 100644 --- a/elpa/forge-20250516.1009/forge-gitea.el +++ b/elpa/forge-20251201.1658/forge-gitea.el @@ -22,7 +22,6 @@ ;;; Code: -(require 'gtea) (require 'forge) ;;; Class @@ -44,5 +43,12 @@ (pullreq-refspec :initform "+refs/pull/*/head:refs/pullreqs/*"))) ;;; _ +;; Local Variables: +;; read-symbol-shorthands: ( +;; ("and$" . "cond-let--and$") +;; ("and-let" . "cond-let--and-let") +;; ("if-let" . "cond-let--if-let") +;; ("when-let" . "cond-let--when-let")) +;; End: (provide 'forge-gitea) ;;; forge-gitea.el ends here diff --git a/elpa/forge-20250516.1009/forge-github.el b/elpa/forge-20251201.1658/forge-github.el similarity index 55% rename from elpa/forge-20250516.1009/forge-github.el rename to elpa/forge-20251201.1658/forge-github.el index a255baee..639e93fc 100644 --- a/elpa/forge-20250516.1009/forge-github.el +++ b/elpa/forge-20251201.1658/forge-github.el @@ -22,9 +22,7 @@ ;;; Code: -(require 'ghub) - -(require 'forge) +(require 'forge-client) (require 'forge-discussion) (require 'forge-issue) (require 'forge-pullreq) @@ -55,6 +53,155 @@ (forge-github-repository-p (forge-get-repository :stub?))) ;;; Pull +;;;; GraphQL + +(defconst forge--github-sparse-repository-query + '(query + ( repository + [(owner $owner String!) + (name $name String!)] + name + id + createdAt + updatedAt + nameWithOwner + (parent nameWithOwner) + description + homepageUrl + (defaultBranchRef name) + isArchived + isFork + isLocked + isMirror + isPrivate + hasDiscussionsEnabled + hasIssuesEnabled + hasWikiEnabled + (licenseInfo name) + (stargazers totalCount) + (watchers totalCount)))) + +(defconst forge--github-repository-query + `(query + ( repository + ,@(cdr (cadr forge--github-sparse-repository-query)) + ( assignableUsers [(:edges t)] + id + login + name) + ( discussionCategories [(:edges t)] + id + name + emoji + isAnswerable + description) + ( discussions [(:edges t) + (:singular discussion number) + (orderBy ((field UPDATED_AT) (direction DESC)))] + id + databaseId + number + url + stateReason + ;; Discussions lack isReadByViewer. + (answer id) + (author login) + title + createdAt + updatedAt + closedAt + locked + (category id) + body + ( comments [(:edges t)] + id + databaseId + (author login) + createdAt + updatedAt + body + ( replies [(:edges 20)] + id + databaseId + (author login) + createdAt + updatedAt + body)) + ( labels [(:edges t)] id)) + ( issues [(:edges t) + (:singular issue number) + (orderBy ((field UPDATED_AT) (direction DESC)))] + number + id + state + stateReason + isReadByViewer + (author login) + title + createdAt + updatedAt + closedAt + locked + (milestone id) + body + ( assignees [(:edges t)] id) + ( comments [(:edges t)] + id + databaseId + (author login) + createdAt + updatedAt + body) + ( labels [(:edges t)] id)) + ( labels [(:edges t) (:singular label id)] + id + name + color + description) + ( milestones [(:edges t) (:singular milestone id)] + id + number + title + createdAt + updatedAt + dueOn + closedAt + description) + ( pullRequests [(:edges t) + (:singular pullRequest number) + (orderBy ((field UPDATED_AT) (direction DESC)))] + number + id + state + isReadByViewer + (author login) + title + createdAt + updatedAt + closedAt + mergedAt + isDraft + locked + maintainerCanModify + isCrossRepository + (milestone id) + body + (baseRef name (repository nameWithOwner)) + baseRefOid + (headRef name (repository (owner login) nameWithOwner)) + headRefOid + ( assignees [(:edges t)] id) + ( reviewRequests [(:edges t)] + (requestedReviewer "... on User { id }\n")) + ( comments [(:edges t)] + id + databaseId + (author login) + createdAt + updatedAt + body) + ( labels [(:edges t)] id))))) + ;;;; Repository (cl-defmethod forge--pull ((repo forge-github-repository) @@ -63,38 +210,41 @@ (setq forge--mode-line-buffer (current-buffer)) (forge--msg repo t nil "Pulling REPO") (let ((buf (current-buffer))) - (ghub-fetch-repository - (oref repo owner) - (oref repo name) - (lambda (data) - (forge--msg repo t t "Pulling REPO") - (forge--msg repo t nil "Storing REPO") - (closql-with-transaction (forge-db) - (let-alist data - (forge--update-repository repo data) - (forge--update-assignees repo .assignableUsers) - (forge--update-forks repo .forks) - (forge--update-labels repo .labels) - (forge--update-milestones repo .milestones) - (forge--update-discussion-categories repo .discussionCategories) - (forge--update-discussions repo .discussions t) - (forge--update-issues repo .issues t) - (forge--update-pullreqs repo .pullRequests t) - (forge--update-revnotes repo .commitComments)) - (oset repo condition :tracked)) - (forge--msg repo t t "Storing REPO") - (cond - ((oref repo selective-p)) - (callback (funcall callback)) - ((forge--maybe-git-fetch repo buf)))) - ;; Keys have the form `FIELD-until', where FIELD is the name of a - ;; field of Repository objects. See `ghub--graphql-walk-response'. - `((discussions-until . ,(or since (oref repo discussions-until))) - (issues-until . ,(or since (oref repo issues-until))) - (pullRequests-until . ,(or since (oref repo pullreqs-until)))) - :host (oref repo apihost) - :auth 'forge - :sparse (oref repo selective-p)))) + (forge--query repo + (if (oref repo selective-p) + forge--github-sparse-repository-query + forge--github-repository-query) + `((owner . ,(oref repo owner)) + (name . ,(oref repo name))) + :callback + (lambda (data) + (forge--msg repo t t "Pulling REPO") + (forge--msg repo t nil "Storing REPO") + (closql-with-transaction (forge-db) + (let-alist data + (forge--update-repository repo data) + (forge--update-assignees repo .assignableUsers) + (forge--update-forks repo .forks) + (forge--update-labels repo .labels) + (forge--update-milestones repo .milestones) + (forge--update-discussion-categories repo .discussionCategories) + (forge--update-discussions repo .discussions t) + (forge--update-issues repo .issues t) + (forge--update-pullreqs repo .pullRequests t) + (forge--update-revnotes repo .commitComments)) + (oset repo condition :tracked)) + (forge--msg repo t t "Storing REPO") + (cond + ((oref repo selective-p)) + (callback (funcall callback)) + ((forge--maybe-git-fetch repo buf)))) + :narrow '(repository) + :until + ;; Keys have the form `FIELD-until', where FIELD is the name of a + ;; field of Repository objects. See `ghub--graphql-walk-response'. + `((discussions-until . ,(or since (oref repo discussions-until))) + (issues-until . ,(or since (oref repo issues-until))) + (pullRequests-until . ,(or since (oref repo pullreqs-until))))))) (cl-defmethod forge--update-repository ((repo forge-github-repository) data) (let-alist data @@ -204,73 +354,59 @@ (cl-defmethod forge--pull-topic ((repo forge-github-repository) (number number)) - (let ((id (oref repo id))) - (forge--pull-topic - repo - (forge-issue :repository id :number number) - :errorback - (lambda (err _headers _status _req) - (when (equal (cdr (assq 'type (cadr err))) "NOT_FOUND") - (forge--pull-topic - repo - (forge-pullreq :repository id :number number) - :errorback - (lambda (err _headers _status _req) - (when (equal (cdr (assq 'type (cadr err))) "NOT_FOUND") - (forge--pull-topic - repo - (forge-discussion :repository id :number number)))))))))) + (forge--query repo + `(query + [($owner String!) + ($name String!)] + (repository + [(owner $owner) + (name $name)] + ,(caddr (caddr (ghub--graphql-prepare-query + forge--github-repository-query + `(repository discussions (discussion . ,number))))) + ,(caddr (caddr (ghub--graphql-prepare-query + forge--github-repository-query + `(repository issues (issue . ,number))))) + ,(caddr (caddr (ghub--graphql-prepare-query + forge--github-repository-query + `(repository pullRequests (pullreq . ,number))))))) + `((owner . ,(oref repo owner)) + (name . ,(oref repo name))) + :noerror t + :callback (lambda (data) + (let-alist data + (cond ((setq data .repository.discussion) + (forge--update-discussion repo data)) + ((setq data .repository.issue) + (forge--update-issue repo data)) + ((setq data .repository.pullRequest) + (forge--update-pullreq repo data)))) + (forge-refresh-buffer)))) (cl-defmethod forge--pull-topic ((repo forge-github-repository) - (topic forge-discussion) - &key callback errorback) - (let ((buffer (current-buffer))) - (ghub-fetch-discussion - (oref repo owner) - (oref repo name) - (oref topic number) - (lambda (data) - (forge--update-discussion repo data) - (forge-refresh-buffer buffer) - (when callback (funcall callback))) - nil - :host (oref repo apihost) - :auth 'forge - :errorback errorback))) + (topic forge-discussion)) + (forge--pull-topic-1 repo #'forge--update-discussion + `(repository discussions (discussion . ,(oref topic number))))) (cl-defmethod forge--pull-topic ((repo forge-github-repository) - (topic forge-issue) - &key callback errorback) - (let ((buffer (current-buffer))) - (ghub-fetch-issue - (oref repo owner) - (oref repo name) - (oref topic number) - (lambda (data) - (forge--update-issue repo data) - (forge-refresh-buffer buffer) - (when callback (funcall callback))) - nil - :host (oref repo apihost) - :auth 'forge - :errorback errorback))) + (topic forge-issue)) + (forge--pull-topic-1 repo #'forge--update-issue + `(repository issues (issue . ,(oref topic number))))) (cl-defmethod forge--pull-topic ((repo forge-github-repository) - (topic forge-pullreq) - &key callback errorback) - (let ((buffer (current-buffer))) - (ghub-fetch-pullreq - (oref repo owner) - (oref repo name) - (oref topic number) - (lambda (data) - (forge--update-pullreq repo data) - (forge-refresh-buffer buffer) - (when callback (funcall callback))) - nil - :host (oref repo apihost) - :auth 'forge - :errorback errorback))) + (topic forge-pullreq)) + (forge--pull-topic-1 repo #'forge--update-pullreq + `(repository pullRequests (pullRequest . ,(oref topic number))))) + +(cl-defun forge--pull-topic-1 (repo update narrow) + (declare (indent defun)) + (forge--query repo + (ghub--graphql-prepare-query forge--github-repository-query narrow) + `((owner . ,(oref repo owner)) + (name . ,(oref repo name))) + :callback (lambda (data) + (funcall update repo (cdr (cadr (cadr data)))) + (forge-refresh-buffer)))) (cl-defmethod forge--update-status ((repo forge-github-repository) topic data bump initial-pull) @@ -278,7 +414,26 @@ (let ((updated (or .updatedAt .createdAt)) (current-status (oref topic status))) (if (forge-discussion-p topic) - ;; Discussions lack `isReadByViewer'. + ;; Discussions lack `isReadByViewer', so we have to use a + ;; heuristic, which is even worse than what we use for other + ;; topic types. Except during the repository's initial pull, + ;; all new discussions start out as `unread'. + ;; + ;; If we pull a discussion after the user mutated it, setting + ;; the status to `unread' is highly undesirable (since they made + ;; the mutation, they have already "read" it), yet that is what + ;; we do here. However, the callback used by the discussion + ;; method of `forge--pull-topic', afterwards resets the status + ;; to the previous value. + ;; + ;; Of course it is possible that we pull other changes by other + ;; people at the same time, but we have no (reasonable) way of + ;; knowing that. So in that case too the status sadly doesn't + ;; end up as `unread'. + ;; + ;; The callback kludge is not needed for all mutations. Some + ;; mutations (e.g., setting labels) do not cause `updated_at' + ;; to be bumped; this second defect cancels out the first. (cond (initial-pull (oset topic status 'done)) ((null current-status) @@ -520,9 +675,10 @@ ;; which we suppress. See #164. (with-demoted-errors "forge--pull-notifications: %S" (forge--ghub-massage-notification data githost))) - (forge--ghub-get nil "/notifications" - `((all . t) ,@(and since `((since . ,since)))) - :host apihost :unpaginate t))) + (forge-rest apihost "GET" "/notifications" + ((all t) + (and since (since since))) + :unpaginate t))) ;; Split into multiple requests to reduce risk of timeouts. (groups (seq-partition notifs 50)) (pages (length groups)) @@ -533,14 +689,13 @@ (when data (setq topics (nconc topics (cdr data)))) (if groups - (let* ((query (seq-keep #'caddr (pop groups))) + (let* ((query (cons 'query (seq-keep #'caddr (pop groups)))) (tries 3) (errorback nil) (vacuum (lambda () - (ghub--graphql-vacuum - (cons 'query query) nil #'cb nil - :auth 'forge :host apihost - :errorback errorback)))) + (forge--query apihost query nil + :callback #'cb + :errorback errorback)))) ;; Github also returns notifications for issues ;; belonging to repositories for which issues ;; have been disabled. Drop them and try again. @@ -549,19 +704,19 @@ (if (zerop tries) (ghub--signal-error errors) (cl-decf tries) - (if-let ((notfound - (seq-keep - (lambda (err) - (and (equal (cdr (assq 'type err)) - "NOT_FOUND") - (cadr (assq 'path err)) - (intern (cadr (assq 'path err))))) - (cdr errors)))) - (progn - (setq query (cl-delete-if (##memq % notfound) - query :key #'caar)) - (funcall vacuum)) - (ghub--signal-error errors))))) + (cond-let + ([notfound + (seq-keep + (lambda (err) + (and (equal (cdr (assq 'type err)) + "NOT_FOUND") + (cadr (assq 'path err)) + (intern (cadr (assq 'path err))))) + (cdr errors))] + (setq query (cl-delete-if (##memq % notfound) + query :key #'caar)) + (funcall vacuum)) + ((ghub--signal-error errors)))))) (cl-incf page) (forge--msg nil t nil "Pulling notifications (page %s/%s)" page pages) @@ -576,12 +731,12 @@ (cb))))) (defun forge--ghub-notifications-since (forge) - (caar (forge-sql [:select :distinct [notification:updated] - :from [notification repository] - :where (and (= repository:forge $s1) - (= repository:id notification:repository)) - :order-by [(desc notification:updated)]] - forge))) + (forge-sql1 [:select :distinct [notification:updated] + :from [notification repository] + :where (and (= repository:forge $s1) + (= repository:id notification:repository)) + :order-by [(desc notification:updated)]] + forge)) (defun forge--ghub-massage-notification (data githost) (let-alist data @@ -613,7 +768,7 @@ ,@(cddr (caddr (ghub--graphql-prepare-query - ghub-fetch-repository + forge--github-repository-query (pcase type ('discussion `(repository discussions @@ -630,7 +785,7 @@ (closql-with-transaction (forge-db) (pcase-dolist (`(,alias ,id ,_query ,repo ,type ,data) notifs) (let-alist data - (and-let* + (when-let* ((topic-data (cdr (cadr (assq alias topics)))) (topic (funcall (pcase-exhaustive type ('discussion #'forge--update-discussion) @@ -667,32 +822,25 @@ (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 - (mapcar (##alist-get 'name %) - (let-alist d .user.repositories)))) - nil :auth 'forge :host host)) + (forge-query host + (user [(login $login String!)] + (repositories [(:edges t) (ownerAffiliations . (OWNER))] name)) + ((login user)) + :callback (lambda (d) + (funcall callback + (mapcar (##alist-get 'name %) + (let-alist d .user.repositories)))))) (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 - (mapcar (##alist-get 'name %) - (let-alist d .organization.repositories)))) - nil :auth 'forge :host host)) + (forge-query host + (organization [(login $login String!)] + (repositories [(:edges t)] name)) + ((login org)) + :callback (lambda (d) + (funcall callback + (mapcar (##alist-get 'name %) + (let-alist d .organization.repositories)))))) (defun forge--batch-add-callback (host owner names) (let ((repos (mapcan (lambda (name) @@ -710,144 +858,204 @@ ;;; Mutations -(cl-defmethod forge--submit-create-discussion ((_ forge-github-repository) - repo category) - (let-alist (forge--topic-parse-buffer) - (ghub--graphql - '(mutation (createDiscussion - [(input $input CreateDiscussionInput!)] - clientMutationId)) - `((input (repositoryId . ,(forge--their-id repo)) - (categoryId - . , (caar (forge-sql [:select [their-id] - :from discussion-category - :where (and (= repository $s1) - (= name $s2))] - (oref repo id) - category))) - (title . , .title) - (body . , .body))) - :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 `((labels . , .labels))) - ,@(and .assignees `((assignees . , .assignees)))) - :callback (forge--post-submit-callback) +(cl-defmethod forge--submit-create-discussion ((repo forge-github-repository) _) + (pcase-let ((`(,title . ,body) (forge--post-buffer-text))) + (forge-mutate repo createDiscussion + ((repositoryId (forge--their-id repo)) + (categoryId (forge--their-id forge--buffer-category 'category repo)) + (title title) + (body body)) + :callback (forge--post-submit-callback t) :errorback (forge--post-submit-errorback)))) -(cl-defmethod forge--create-pullreq-from-issue ((repo forge-github-repository) - (issue forge-issue) - source target) +(cl-defmethod forge--submit-create-issue ((repo forge-github-repository) _) + (pcase-let ((`(,title . ,body) (forge--post-buffer-text))) + (forge-mutate repo createIssue + ((repositoryId (forge--their-id repo)) + (title title) + (body body) + (and forge--buffer-milestone + (milestoneId + (forge--their-id forge--buffer-milestone 'milestone))) + (and forge--buffer-labels + (labelIds + (vconcat (forge--their-id forge--buffer-labels 'labels repo)))) + (and forge--buffer-assignees + (assigneeIds + (vconcat (forge--their-id forge--buffer-assignees 'assignees repo))))) + :callback (forge--post-submit-callback t) + :errorback (forge--post-submit-errorback)))) + +(cl-defmethod forge--create-pullreq-from-issue + ((repo forge-github-repository) + (issue forge-issue) + source target) (pcase-let* ((`(,base-remote . ,base-branch) (magit-split-branch-name target)) (`(,head-remote . ,head-branch) (magit-split-branch-name source)) (head-repo (forge-get-repository :stub head-remote))) - (forge--ghub-post repo "/repos/:owner/:repo/pulls" - `((issue . ,(oref issue number)) - (base . ,base-branch) - (head . ,(if (equal head-remote base-remote) - head-branch - (concat (oref head-repo owner) ":" - head-branch))) - (maintainer_can_modify . t)) + (forge-rest repo "POST" "/repos/:owner/:repo/pulls" + ((issue (oref issue number)) + (base base-branch) + (head (if (equal head-remote base-remote) + head-branch + (concat (oref head-repo owner) ":" head-branch))) + (maintainer_can_modify t)) :callback (lambda (&rest _) (closql-delete issue) - (forge-pull)) - :errorback (lambda (&rest _) (forge-pull))))) - -(cl-defmethod forge--submit-create-pullreq ((_ forge-github-repository) repo) - (let-alist (forge--topic-parse-buffer) - (when (and .yaml (local-variable-p 'forge-buffer-draft-p)) - (user-error "Cannot use yaml frontmatter and set `%s' at the same time" - 'forge-buffer-draft-p)) - (pcase-let* ((`(,base-remote . ,base-branch) - (magit-split-branch-name forge--buffer-base-branch)) - (`(,head-remote . ,head-branch) - (magit-split-branch-name forge--buffer-head-branch)) - (head-repo (forge-get-repository :stub head-remote))) - (forge--ghub-post repo "/repos/:owner/:repo/pulls" - `((title . , .title) - (body . , .body) - (base . ,base-branch) - (head . ,(if (equal head-remote base-remote) - head-branch - (concat (oref head-repo owner) ":" - head-branch))) - (draft . ,(if (local-variable-p 'forge-buffer-draft-p) - forge-buffer-draft-p - .draft)) - (maintainer_can_modify . t)) - :callback (forge--post-submit-callback) - :errorback (forge--post-submit-errorback))))) - -(cl-defmethod forge--submit-create-post ((_ forge-github-repository) post) - (cond - ((cl-typep post '(or forge-discussion forge-discussion-post)) - (ghub-graphql - `(mutation (addDiscussionComment - [(input $input AddDiscussionCommentInput!)] - clientMutationId)) - `((input - ,@(if (cl-typep post 'forge-discussion-post) - `((discussionId . ,(oref (forge-get-discussion post) their-id)) - (replyToId . ,(oref post their-id))) - `((discussionId . ,(oref post their-id)))) - (body . ,(string-trim (buffer-string))))) - :callback (forge--post-submit-callback) - :errorback (forge--post-submit-errorback))) - (t - (forge--ghub-post post "/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))))) + (forge--pull repo)) + :errorback (lambda (&rest _) (forge--pull repo))))) + +(cl-defmethod forge--submit-create-pullreq ((repo forge-github-repository) _) + (pcase-let* ((`(,title . ,body) (forge--post-buffer-text)) + (`(,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))) + ;; Cannot use `createPullRequest' because value for + ;; `headRepositoryId' is unavailable. + (forge-rest repo "POST" "/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 forge--buffer-draft-p) + (maintainer_can_modify t)) + :callback (forge--post-submit-callback t) + :errorback (forge--post-submit-errorback)))) + +(cl-defmethod forge--submit-create-post + ((repo forge-github-repository) + (post forge-post)) + (forge-mutate repo addComment + ((subjectId (oref post their-id)) + (body (string-trim (buffer-str)))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))) + +(cl-defmethod forge--submit-create-post + ((repo forge-github-repository) + (post forge-discussion-post)) + (forge-mutate repo addDiscussionComment + ((discussionId (oref (forge-get-discussion post) their-id)) + (replyToId (oref post their-id)) + (body (string-trim (buffer-str)))) :callback (forge--post-submit-callback) :errorback (forge--post-submit-errorback))) -(cl-defmethod forge--submit-approve-pullreq ((_ forge-github-repository) repo) - (let ((body (magit--buffer-string nil nil t))) - (forge--ghub-post repo "/repos/:owner/:repo/pulls/:number/reviews" - `((event . "APPROVE") - ,@(and (not (equal body "")) `((body . ,body)))) +(cl-defmethod forge--submit-create-post + ((repo forge-github-repository) + (post forge-discussion)) + (forge-mutate repo addDiscussionComment + ((discussionId (oref post their-id)) + (body (string-trim (buffer-str)))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))) + +(cl-defmethod forge--submit-edit-post + ((repo forge-github-repository) + (post forge-post)) + (cl-typecase post + ((or forge-issue-post forge-pullreq-post) + ;; Cannot use GraphQL because we made the mistake to derive our ID + ;; from the number instead of their ID. `updatePullRequestComment' + ;; (or something equivalent under an inconsistent name) does not + ;; exist, so for that we would have to continue to use REST anyway. + (forge-rest post "PATCH" "/repos/:owner/:repo/issues/comments/:number" + ((body (string-trim (buffer-str)))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))) + (t + (forge--query repo + `(mutation (,(cl-etypecase post + (forge-discussion 'updateDiscussion) + (forge-issue 'updateIssue) + (forge-pullreq 'updatePullRequest) + (forge-discussion-post 'updateDiscussionComment) + (forge-discussion-reply 'updateDiscussionComment) + (forge-issue-post 'updateIssueComment) + (forge-pullreq-post 'updatePullRequestComment)) + [(input + $input + ,(cl-etypecase post + (forge-discussion 'UpdateDiscussionInput!) + (forge-issue 'UpdateIssueInput!) + (forge-pullreq 'UpdatePullRequestInput!) + (forge-discussion-post 'UpdateDiscussionCommentInput!) + (forge-discussion-reply 'UpdateDiscussionCommentInput!) + (forge-issue-post 'UpdateIssueCommentInput!) + (forge-pullreq-post 'UpdatePullRequestCommentInput!)))] + clientMutationId)) + `((input (,(cl-etypecase post + (forge-discussion 'discussionId) + (forge-issue 'id) + (forge-pullreq 'pullRequestId) + (forge-discussion-post 'commentId) + (forge-discussion-reply 'commentId) + (forge-issue-post 'id) + (forge-pullreq-post 'id)) + . ,(forge--their-id post)) + ,@(if (cl-typep post 'forge-topic) + (pcase-let ((`(,title . ,body) (forge--post-buffer-text))) + `((title . ,title) + (body . ,body))) + `((body . ,(string-trim (buffer-str))))))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))))) + +(cl-defmethod forge--submit-approve-pullreq + ((_repo forge-github-repository) + (topic forge-pullreq)) + (let ((body (string-trim (buffer-str)))) + (forge-rest topic "POST" "/repos/:owner/:repo/pulls/:number/reviews" + ((event "APPROVE") + (and (not (equal body "")) (body body))) :callback (forge--post-submit-callback) :errorback (forge--post-submit-errorback)))) -(cl-defmethod forge--submit-request-changes ((_ forge-github-repository) repo) - (let ((body (magit--buffer-string nil nil t))) - (forge--ghub-post repo "/repos/:owner/:repo/pulls/:number/reviews" - `((event . "REQUEST_CHANGES") - ,@(and (not (equal body "")) `((body . ,body)))) +(cl-defmethod forge--submit-request-changes + ((_repo forge-github-repository) + (topic forge-pullreq)) + (let ((body (string-trim (buffer-str)))) + (forge-rest topic "POST" "/repos/:owner/:repo/pulls/:number/reviews" + ((event "REQUEST_CHANGES") + (and (not (equal body "")) (body body))) :callback (forge--post-submit-callback) :errorback (forge--post-submit-errorback)))) (cl-defmethod forge--set-topic-title - ((_repo forge-github-repository) topic title) - (forge--ghub-patch topic - "/repos/:owner/:repo/issues/:number" - `((title . ,title)) - :callback (forge--set-field-callback topic))) + ((_repo forge-github-repository) + (topic forge-discussion) + title) + (forge--mutate-field topic updateDiscussion + ((discussionId (oref topic their-id)) + (title title)))) + +(cl-defmethod forge--set-topic-title + ((_repo forge-github-repository) + (topic forge-issue) + title) + (forge--mutate-field topic updateIssue + ((id (oref topic their-id)) + (title title)))) + +(cl-defmethod forge--set-topic-title + ((_repo forge-github-repository) + (topic forge-pullreq) + title) + (forge--mutate-field topic updatePullRequest + ((pullRequestId (oref topic their-id)) + (title title)))) (cl-defmethod forge--set-topic-state - ((_repo forge-github-repository) topic state) - (forge--ghub-patch topic - "/repos/:owner/:repo/issues/:number" + ((_repo forge-github-repository) + (topic forge-topic) + state) + (forge--rest topic "PATCH" "/repos/:owner/:repo/issues/:number" (pcase-exhaustive state ;; Merging isn't done through here. ;; Marking as a duplicate isn't supported via API. @@ -861,101 +1069,82 @@ ((_repo forge-github-repository) (topic forge-discussion) state) - (with-slots (their-id) topic - (cond ((eq state 'open) - (ghub--graphql - '(mutation (reopenDiscussion - [(input $input ReopenDiscussionInput!)] - clientMutationId)) - `((input (discussionId . ,their-id))) - :callback (forge--set-field-callback topic t))) - ((ghub--graphql - '(mutation (closeDiscussion - [(input $input CloseDiscussionInput!)] - clientMutationId)) - `((input (discussionId . ,their-id) - (reason . ,(pcase-exhaustive state - ('completed "RESOLVED") - ('duplicate "DUPLICATE") - ('outdated "OUTDATED"))))) - :callback (forge--set-field-callback topic t)))))) + (cond ((eq state 'open) + (forge--mutate-field topic reopenDiscussion + ((discussionId (oref topic their-id))))) + ((forge--mutate-field topic closeDiscussion + ((discussionId (oref topic their-id)) + (reason (pcase-exhaustive state + ('completed "RESOLVED") + ('duplicate "DUPLICATE") + ('outdated "OUTDATED")))))))) (cl-defmethod forge--set-topic-draft - ((_repo forge-github-repository) topic value) - (let ((buffer (current-buffer))) - (ghub-graphql - `(mutation (,(if value - 'convertPullRequestToDraft - 'markPullRequestReadyForReview) - [(input $input ,(if value - 'ConvertPullRequestToDraftInput! - 'MarkPullRequestReadyForReviewInput!))] - (pullRequest isDraft))) - `((input (pullRequestId . ,(oref topic their-id)))) - :host (oref (forge-get-repository topic) apihost) - :auth 'forge - :callback (lambda (data &rest _) - (if (assq 'error data) - (ghub--graphql-pp-response data) - (oset topic draft-p value) - (forge-refresh-buffer buffer)))))) + ((_repo forge-github-repository) + (topic forge-topic) + value) + (cond (value + (forge--mutate-field topic convertPullRequestToDraft + ((pullRequestId (oref topic their-id))))) + ((forge--mutate-field topic markPullRequestReadyForReview + ((pullRequestId (oref topic their-id))))))) (cl-defmethod forge--set-topic-category - ((_repo forge-github-repository) + ((repo forge-github-repository) (topic forge-discussion) category) - (ghub--graphql - '(mutation (updateDiscussion - [(input $input UpdateDiscussionInput!)] - clientMutationId)) - `((input (discussionId . ,(oref topic their-id)) - (categoryId - . , (caar (forge-sql [:select [their-id] - :from discussion-category - :where (and (= repository $s1) - (= name $s2))] - (oref (forge-get-repository :tracked) id) - category))))) - :callback (forge--set-field-callback topic t))) + (forge--mutate-field topic updateDiscussion + ((discussionId (oref topic their-id)) + (categoryId (forge--their-id category 'category repo))))) (cl-defmethod forge--set-topic-answer - ((_repo forge-github-repository) + ((repo forge-github-repository) (topic forge-discussion) answer) (let* ((old (oref topic answer)) (old (and old (forge--their-id old))) (new (and answer (oref answer their-id)))) - (ghub--graphql - `(mutation - ,@(and old '((unmarkDiscussionCommentAsAnswer - [(input $old UnmarkDiscussionCommentAsAnswerInput!)] - clientMutationId))) - ,@(and new '((markDiscussionCommentAsAnswer - [(input $new MarkDiscussionCommentAsAnswerInput!)] - clientMutationId)))) - `(,@(and old `((old (id . ,old)))) - ,@(and new `((new (id . ,new))))) - :callback (forge--set-field-callback topic t)))) + (forge--query repo + `(mutation + ,@(and old '((unmarkDiscussionCommentAsAnswer + [(input $old UnmarkDiscussionCommentAsAnswerInput!)] + clientMutationId))) + ,@(and new '((markDiscussionCommentAsAnswer + [(input $new MarkDiscussionCommentAsAnswerInput!)] + clientMutationId)))) + `(,@(and old `((old (id . ,old)))) + ,@(and new `((new (id . ,new))))) + :callback (forge--set-field-callback topic)))) (cl-defmethod forge--set-topic-milestone - ((repo forge-github-repository) topic milestone) - (forge--ghub-patch topic - "/repos/:owner/:repo/issues/:number" - (if milestone - `((milestone . ,(caar (forge-sql [:select [number] - :from milestone - :where (and (= repository $s1) - (= title $s2))] - (oref repo id) - milestone)))) - `((milestone . :null))) + ((repo forge-github-repository) + (topic forge-topic) + milestone) + (forge-rest topic "POST" "/repos/:owner/:repo/issues/:number" + ((milestone (if milestone + (forge-sql1 [:select [number] + :from milestone + :where (and (= repository $s1) + (= title $s2))] + (oref repo id) + milestone) + :null))) :callback (forge--set-field-callback topic))) (cl-defmethod forge--set-topic-labels - ((repo forge-github-repository) topic labels) + ((repo forge-github-repository) + (topic forge-topic) + labels) (let* ((topic-id (oref topic their-id)) - (old (mapcar (##forge--their-id (car %)) (oref topic labels))) - (new (mapcar (##forge--their-id (car %)) + (their-id ; I really messed up IDs! :( + (pcase-lambda (`(,id)) + (let* ((parts (split-string (base64-decode-string id) ":")) + (maybe-id (car (last parts)))) + (if (string-prefix-p "Label" maybe-id) + (base64-encode-string (string-join (last parts 2) ":")) + maybe-id)))) + (old (mapcar their-id (oref topic labels))) + (new (mapcar their-id (forge-sql [:select [id] :from label :where (and (= repository $s1) (in name $v2))] @@ -964,67 +1153,60 @@ (add (cl-set-difference new old :test #'equal)) (del (cl-set-difference old new :test #'equal))) (when (or add del) - (ghub--graphql - `(mutation - ,@(and add '((addLabelsToLabelable - [(input $add AddLabelsToLabelableInput!)] - clientMutationId))) - ,@(and del '((removeLabelsFromLabelable - [(input $del RemoveLabelsFromLabelableInput!)] - clientMutationId)))) - `(,@(and add `((add (labelableId . ,topic-id) - (labelIds . ,(vconcat add))))) - ,@(and del `((del (labelableId . ,topic-id) - (labelIds . ,(vconcat del)))))) - :callback (forge--set-field-callback topic))))) + (forge--query repo + `(mutation + ,@(and add '((addLabelsToLabelable + [(input $add AddLabelsToLabelableInput!)] + clientMutationId))) + ,@(and del '((removeLabelsFromLabelable + [(input $del RemoveLabelsFromLabelableInput!)] + clientMutationId)))) + `(,@(and add `((add (labelableId . ,topic-id) + (labelIds . ,(vconcat add))))) + ,@(and del `((del (labelableId . ,topic-id) + (labelIds . ,(vconcat del)))))) + :callback (forge--set-field-callback topic))))) (cl-defmethod forge--set-topic-assignees - ((repo forge-github-repository) topic assignees) + ((repo forge-github-repository) + (topic forge-topic) + assignees) (let* ((topic-id (oref topic their-id)) (old (mapcar (##nth 3 %) (oref topic assignees))) - (new (forge-sql-car [:select [forge-id] :from assignee - :where (and (= repository $s1) - (in login $v2))] - (oref repo id) - (vconcat assignees))) + (new (forge--their-id assignees 'assignees repo)) (add (cl-set-difference new old :test #'equal)) (del (cl-set-difference old new :test #'equal))) (when (or add del) - (ghub--graphql - `(mutation - ,@(and add '((addAssigneesToAssignable - [(input $add AddAssigneesToAssignableInput!)] - clientMutationId))) - ,@(and del '((removeAssigneesFromAssignable - [(input $del RemoveAssigneesFromAssignableInput!)] - clientMutationId)))) - `(,@(and add `((add (assignableId . ,topic-id) - (assigneeIds . ,(vconcat add))))) - ,@(and del `((del (assignableId . ,topic-id)) - (assigneeIds . ,(vconcat del))))) - :callback (forge--set-field-callback topic))))) + (forge--query repo + `(mutation + ,@(and add '((addAssigneesToAssignable + [(input $add AddAssigneesToAssignableInput!)] + clientMutationId))) + ,@(and del '((removeAssigneesFromAssignable + [(input $del RemoveAssigneesFromAssignableInput!)] + clientMutationId)))) + `(,@(and add `((add (assignableId . ,topic-id) + (assigneeIds . ,(vconcat add))))) + ,@(and del `((del (assignableId . ,topic-id) + (assigneeIds . ,(vconcat del)))))) + :callback (forge--set-field-callback topic))))) (cl-defmethod forge--set-topic-review-requests - ((repo forge-github-repository) topic reviewers) - (let ((users (forge-sql-car - [:select [forge-id] :from assignee - :where (and (= repository $s1) - (in login $v2))] - (oref repo id) - (vconcat (seq-remove (##string-match "/" %) reviewers)))) + ((repo forge-github-repository) + (topic forge-topic) + reviewers) + (let ((users (forge--their-id (seq-remove (##string-match "/" %) reviewers) + 'assignees repo)) (teams nil)) ;TODO Investigate #742, track id, then use it here. - (ghub--graphql - `(mutation (requestReviews - [(input $input RequestReviewsInput!)] - clientMutationId)) - `((input (pullRequestId . ,(oref topic their-id)) - ,@(and users `((userIds . ,(vconcat users)))) - ,@(and teams `((teamIds . ,(vconcat teams)))))) - :callback (forge--set-field-callback topic)))) + (forge--mutate-field topic requestReviews + ((pullRequestId (oref topic their-id)) + (and users (userIds (vconcat users))) + (and teams (teamIds (vconcat teams))))))) (cl-defmethod forge--delete-comment - ((_repo forge-github-repository) post) - (forge--ghub-delete post "/repos/:owner/:repo/issues/comments/:number") + ((_ forge-github-repository) + (post forge-post)) + (forge-rest post "DELETE" "/repos/:owner/:repo/issues/comments/:number") (closql-delete post) (forge-refresh-buffer)) @@ -1052,7 +1234,7 @@ ;; When there are multiple conflicting "default" templates, the rules ;; used by Github are more complex than just sorting alphabetically and ;; then taking the first found file. Too bad; that's what we do. - (let ((branch (oref repo default-branch)) + (let ((branch (forge--get-default-branch repo)) (case-fold-search t)) (seq-some (lambda (file) (and (string-match-p "\ @@ -1062,9 +1244,8 @@ "-r" branch)))) (cl-defmethod forge--set-default-branch ((repo forge-github-repository) branch) - (forge--ghub-patch repo - "/repos/:owner/:repo" - `((default_branch . ,branch))) + (forge-rest repo "PATCH" "/repos/:owner/:repo" + ((default_branch branch))) (message "Waiting 5 seconds for GitHub to complete update...") (sleep-for 5) (message "Waiting 5 seconds for GitHub to complete update...done") @@ -1074,36 +1255,38 @@ (cl-defmethod forge--rename-branch ((repo forge-github-repository) newname oldname) - (forge--ghub-post repo + (forge-rest repo "POST" (format "/repos/:owner/:name/branches/%s/rename" oldname) - `((new_name . ,newname))) + ((new_name newname))) (message "Waiting 5 seconds for GitHub to complete rename...") (sleep-for 5) (message "Waiting 5 seconds for GitHub to complete rename...done") (magit-call-git "fetch" "--prune" (oref repo remote))) -(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) - pullreq hash method) - (forge--ghub-put pullreq - "/repos/:owner/:repo/pulls/:number/merge" - `((merge_method . ,(symbol-name method)) - ,@(and hash `((sha . ,hash)))) - :errorback t +(cl-defmethod forge--fork-repository ((repo forge-github-repository) fork all) + (with-slots (name apihost) repo + (forge-rest repo "POST" "/repos/:owner/:name/forks" + ((and (not (equal fork (ghub--username apihost))) + (organization fork)) + (default-branch-only (not all)))) + (ghub-wait (format "/repos/%s/%s" fork name) + nil :auth 'forge :host apihost))) + +(cl-defmethod forge--merge-pullreq + ((repo forge-github-repository) + (topic forge-pullreq) + hash method) + (forge-mutate topic mergePullRequest + ((pullRequestId (oref topic their-id)) + (mergeMethod (upcase (symbol-name method))) + (and hash (expectedHeadOid hash))) :callback - (lambda (&rest _) + (lambda (_) (forge--pull repo (lambda () - (when-let* ((branch (or (forge--pullreq-branch-active pullreq) - (forge--branch-pullreq pullreq))) + (when-let* ((branch (or (forge--pullreq-branch-active topic) + (forge--branch-pullreq topic))) (upstream (magit-get-local-upstream-branch branch)) (remote (oref repo remote))) (magit-call-git "checkout" upstream) @@ -1111,90 +1294,16 @@ (magit-call-git "branch" "-d" branch) (forge-refresh-buffer))))))) -;;; Wrappers - -(cl-defun forge--ghub-get (obj resource - &optional params - &key query payload headers - silent unpaginate noerror reader - host - callback errorback) - (declare (indent defun)) - (ghub-get (if obj (forge--format-resource obj resource) resource) - params - :host (or host (oref (forge-get-repository obj) apihost)) - :auth 'forge - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :callback callback :errorback errorback)) - -(cl-defun forge--ghub-put (obj resource - &optional params - &key query payload headers - silent unpaginate noerror reader - host - callback errorback) - (declare (indent defun)) - (ghub-put (if obj (forge--format-resource obj resource) resource) - params - :host (or host (oref (forge-get-repository obj) apihost)) - :auth 'forge - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :callback callback :errorback errorback)) - -(cl-defun forge--ghub-post (obj resource - &optional params - &key query payload headers - silent unpaginate noerror reader - host callback errorback) - (declare (indent defun)) - (ghub-post (forge--format-resource obj resource) - params - :host (or host (oref (forge-get-repository obj) apihost)) - :auth 'forge - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :callback callback :errorback errorback)) - -(cl-defun forge--ghub-patch (obj resource - &optional params - &key query payload headers - silent unpaginate noerror reader - host callback errorback) - (declare (indent defun)) - (ghub-patch (forge--format-resource obj resource) - params - :host (or host (oref (forge-get-repository obj) apihost)) - :auth 'forge - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :callback callback :errorback errorback)) - -(cl-defun forge--ghub-delete (obj resource - &optional params - &key query payload headers - silent unpaginate noerror reader - host callback errorback) - (declare (indent defun)) - (ghub-delete (forge--format-resource obj resource) - params - :host (or host (oref (forge-get-repository obj) apihost)) - :auth 'forge - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :callback callback :errorback errorback)) - ;;; _ ;; Local Variables: ;; read-symbol-shorthands: ( -;; ("partial" . "llama--left-apply-partially") -;; ("rpartial" . "llama--right-apply-partially")) +;; ("and$" . "cond-let--and$") +;; ("and-let" . "cond-let--and-let") +;; ("if-let" . "cond-let--if-let") +;; ("when-let" . "cond-let--when-let") +;; ("buffer-string" . "buffer-string") +;; ("buffer-str" . "forge--buffer-substring-no-properties") +;; ("partial" . "llama--left-apply-partially")) ;; End: (provide 'forge-github) ;;; forge-github.el ends here diff --git a/elpa/forge-20250516.1009/forge-gitlab.el b/elpa/forge-20251201.1658/forge-gitlab.el similarity index 82% rename from elpa/forge-20250516.1009/forge-gitlab.el rename to elpa/forge-20251201.1658/forge-gitlab.el index 1343f5d9..f5c98d51 100644 --- a/elpa/forge-20250516.1009/forge-gitlab.el +++ b/elpa/forge-20251201.1658/forge-gitlab.el @@ -22,9 +22,7 @@ ;;; Code: -(require 'glab) - -(require 'forge) +(require 'forge-client) (require 'forge-issue) (require 'forge-pullreq) @@ -154,7 +152,7 @@ (forge--glab-get repo "/projects/:project/issues" `((per_page . 100) (order_by . "updated_at") - ,@(and-let* ((after (or since (oref repo issues-until)))) + ,@(and-let ((after (or since (oref repo issues-until)))) `((updated_after . ,after)))) :unpaginate t :callback (lambda (value _headers _status _req) @@ -249,7 +247,7 @@ (forge--glab-get repo "/projects/:project/merge_requests" `((per_page . 100) (order_by . "updated_at") - ,@(and-let* ((after (or since (oref repo pullreqs-until)))) + ,@(and-let ((after (or since (oref repo pullreqs-until)))) `((updated_after . ,after)))) :unpaginate t :callback (lambda (value _headers _status _req) @@ -451,45 +449,47 @@ ;;; Mutations (cl-defmethod forge--submit-create-issue ((_ forge-gitlab-repository) repo) - (let-alist (forge--topic-parse-buffer) - (forge--glab-post repo "/projects/:project/issues" - `((title . , .title) - (description . , .body)) + (forge--glab-post repo "/projects/:project/issues" + (pcase-let ((`(,title . ,body) (forge--post-buffer-text))) + `((title . ,title) + (description . ,body))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))) + +(cl-defmethod forge--submit-create-pullreq ((_ forge-gitlab-repository) base-repo) + (pcase-let* ((`(,title . ,body) (forge--post-buffer-text)) + (`(,_base-remote . ,base-branch) + (magit-split-branch-name forge--buffer-base-branch)) + (`(,head-remote . ,head-branch) + (magit-split-branch-name forge--buffer-head-branch)) + (head-repo (forge-get-repository :stub head-remote))) + (forge--glab-post head-repo "/projects/:project/merge_requests" + `((title . ,(if forge--buffer-draft-p + (concat "Draft: " title) + title)) + (description . ,body) + ;; ,@(and (not (equal head-remote base-remote)) + (target_project_id . ,(oref base-repo forge-id)) + (target_branch . ,base-branch) + (source_branch . ,head-branch) + (allow_collaboration . t)) :callback (forge--post-submit-callback) :errorback (forge--post-submit-errorback)))) -(cl-defmethod forge--submit-create-pullreq ((_ forge-gitlab-repository) base-repo) - (let-alist (forge--topic-parse-buffer) - (pcase-let* ((`(,base-remote . ,base-branch) - (magit-split-branch-name forge--buffer-base-branch)) - (`(,head-remote . ,head-branch) - (magit-split-branch-name forge--buffer-head-branch)) - (head-repo (forge-get-repository :stub head-remote))) - (forge--glab-post head-repo "/projects/:project/merge_requests" - `((title . ,(if (if (local-variable-p 'forge-buffer-draft-p) - forge-buffer-draft-p - .draft) - (concat "Draft: " .title) - .title)) - (description . , .body) - ,@(and (not (equal head-remote base-remote)) - `((target_project_id . ,(oref base-repo forge-id)))) - (target_branch . ,base-branch) - (source_branch . ,head-branch) - (allow_collaboration . t)) - :callback (forge--post-submit-callback) - :errorback (forge--post-submit-errorback))))) - -(cl-defmethod forge--submit-create-post ((_ forge-gitlab-repository) topic) +(cl-defmethod forge--submit-create-post + ((_ forge-gitlab-repository) + (topic forge-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)))) + `((body . ,(string-trim (buffer-str)))) :callback (forge--post-submit-callback) :errorback (forge--post-submit-errorback))) -(cl-defmethod forge--submit-edit-post ((_ forge-gitlab-repository) post) +(cl-defmethod forge--submit-edit-post + ((_ forge-gitlab-repository) + (post forge-post)) (forge--glab-put post (cl-etypecase post (forge-pullreq "/projects/:project/merge_requests/:number") @@ -497,21 +497,22 @@ (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))))) + (pcase-let ((`(,title . ,body) (forge--post-buffer-text))) + `((title . ,title) + ;; Keep Gitlab from claiming that the user changed + ;; the description when that isn't true. The same + ;; isn't necessary for the title; for that, Gitlab + ;; performs the necessary check itself. + ,@(and (not (equal body (oref post body))) + `((description . ,body))))) + `((body . ,(string-trim (buffer-str))))) :callback (forge--post-submit-callback) :errorback (forge--post-submit-errorback))) (cl-defmethod forge--set-topic-field - ((_repo forge-gitlab-repository) topic field value) + ((_repo forge-gitlab-repository) + (topic forge-topic) + field value) (forge--glab-put topic (cl-typecase topic (forge-pullreq "/projects/:project/merge_requests/:number") @@ -520,11 +521,15 @@ :callback (forge--set-field-callback topic))) (cl-defmethod forge--set-topic-title - ((repo forge-gitlab-repository) topic title) + ((repo forge-gitlab-repository) + (topic forge-topic) + title) (forge--set-topic-field repo topic 'title title)) (cl-defmethod forge--set-topic-state - ((repo forge-gitlab-repository) topic state) + ((repo forge-gitlab-repository) + (topic forge-topic) + state) (forge--set-topic-field repo topic 'state_event (pcase-exhaustive state ;; Merging isn't done through here. @@ -534,30 +539,25 @@ ('open "reopen")))) (cl-defmethod forge--set-topic-draft - ((repo forge-gitlab-repository) topic value) - (let ((buffer (current-buffer))) - (glab-graphql - `(mutation (mergeRequestSetDraft - [(input $input MergeRequestSetDraftInput!)] - (mergeRequest iid draft))) - `((input (projectPath . ,(oref repo slug)) - (iid . ,(number-to-string (oref topic number))) - (draft . ,value))) - :host (oref (forge-get-repository topic) apihost) - :auth 'forge - :callback (lambda (data &rest _) - (if (assq 'error data) - (ghub--graphql-pp-response data) - (oset topic draft-p value) - (forge-refresh-buffer buffer)))))) + ((repo forge-gitlab-repository) + (topic forge-topic) + value) + (forge--mutate-field topic mergeRequestSetDraft + ((projectPath (oref repo slug)) + (iid (number-to-string (oref topic number))) + (draft value)))) (cl-defmethod forge--set-topic-labels - ((repo forge-gitlab-repository) topic labels) + ((repo forge-gitlab-repository) + (topic forge-topic) + labels) (forge--set-topic-field repo topic 'labels (string-join labels ","))) (cl-defmethod forge--set-topic-assignees - ((repo forge-gitlab-repository) topic assignees) + ((repo forge-gitlab-repository) + (topic forge-topic) + assignees) (let ((users (mapcar #'cdr (oref repo assignees)))) (cl-typecase topic (forge-pullreq ; Can only be assigned to a single user. @@ -570,14 +570,17 @@ 0)))))) (cl-defmethod forge--set-topic-review-requests - ((repo forge-gitlab-repository) topic reviewers) + ((repo forge-gitlab-repository) + (topic forge-pullreq) + reviewers) (let ((users (mapcar #'cdr (oref repo assignees)))) (forge--set-topic-field repo topic 'reviewer_ids (or (mapcar (##caddr (assoc % users)) reviewers) 0)))) (cl-defmethod forge--delete-comment - ((_repo forge-gitlab-repository) post) + ((_ forge-gitlab-repository) + (post forge-post)) (forge--glab-delete post (cl-etypecase post (forge-pullreq-post @@ -595,17 +598,19 @@ (_ (subclass forge-pullreq))) (forge--topic-template-files-1 repo "md" ".gitlab/merge_request_templates")) -(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)))) +(cl-defmethod forge--fork-repository ((repo forge-gitlab-repository) fork _all) + (with-slots (name apihost) repo + (forge--glab-post repo "/projects/:project/fork" + (and (not (equal fork (ghub--username apihost 'gitlab))) `((namespace . ,fork))) :noerror t) - (ghub-wait (format "/projects/%s%%2F%s" fork name) - nil :auth 'forge :forge 'gitlab))) + (ghub-wait (format "/projects/%s%%2F%s" (string-replace "/" "%2F" fork) name) + nil :auth 'forge :host apihost :forge 'gitlab))) -(cl-defmethod forge--merge-pullreq ((_repo forge-gitlab-repository) - topic hash method) +(cl-defmethod forge--merge-pullreq + ((_repo forge-gitlab-repository) + (topic forge-topic) + hash method) (forge--glab-put topic "/projects/:project/merge_requests/:number/merge" `((squash . ,(eq method 'squash)) @@ -619,15 +624,16 @@ 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)))) + (ghub-request "GET" (if obj (forge--format-resource obj resource) resource) + params + :forge 'gitlab + :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 @@ -635,15 +641,16 @@ 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)))) + (ghub-request "PUT" (if obj (forge--format-resource obj resource) resource) + params + :forge 'gitlab + :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 @@ -651,15 +658,16 @@ 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)))) + (ghub-request "POST" (forge--format-resource obj resource) + params + :forge 'gitlab + :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 @@ -667,21 +675,26 @@ 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)))) + (ghub-request "DELETE" (forge--format-resource obj resource) + params + :forge 'gitlab + :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)))) ;;; _ ;; Local Variables: ;; read-symbol-shorthands: ( -;; ("partial" . "llama--left-apply-partially") -;; ("rpartial" . "llama--right-apply-partially")) +;; ("and$" . "cond-let--and$") +;; ("and-let" . "cond-let--and-let") +;; ("if-let" . "cond-let--if-let") +;; ("when-let" . "cond-let--when-let") +;; ("buffer-string" . "buffer-string") +;; ("buffer-str" . "forge--buffer-substring-no-properties")) ;; End: (provide 'forge-gitlab) ;;; forge-gitlab.el ends here diff --git a/elpa/forge-20250516.1009/forge-gogs.el b/elpa/forge-20251201.1658/forge-gogs.el similarity index 99% rename from elpa/forge-20250516.1009/forge-gogs.el rename to elpa/forge-20251201.1658/forge-gogs.el index eb3a0cd7..4e71768c 100644 --- a/elpa/forge-20250516.1009/forge-gogs.el +++ b/elpa/forge-20251201.1658/forge-gogs.el @@ -22,7 +22,6 @@ ;;; Code: -(require 'gogs) (require 'forge) ;;; Class diff --git a/elpa/forge-20250516.1009/forge-issue.el b/elpa/forge-20251201.1658/forge-issue.el similarity index 91% rename from elpa/forge-20250516.1009/forge-issue.el rename to elpa/forge-20251201.1658/forge-issue.el index 0fefc981..d9ebe969 100644 --- a/elpa/forge-20250516.1009/forge-issue.el +++ b/elpa/forge-20251201.1658/forge-issue.el @@ -116,13 +116,14 @@ issue) (cl-defmethod forge-get-issue ((repo forge-repository) number) + (cl-assert (numberp number) t) (closql-get (forge-db) (forge--object-id 'forge-issue repo number) 'forge-issue)) (cl-defmethod forge-get-issue ((number integer)) - (and-let* ((repo (forge-get-repository :tracked nil 'notatpt))) - (forge-get-issue repo number))) + (and$ (forge-get-repository :tracked nil 'notatpt) + (forge-get-issue $ number))) (cl-defmethod forge-get-issue ((id string)) (closql-get (forge-db) id 'forge-issue)) @@ -153,9 +154,9 @@ an error." (put 'forge-issue 'thing-at-point #'forge-thingatpt--issue) (defun forge-thingatpt--issue () - (and-let* (((thing-at-point-looking-at "#\\([0-9]+\\)\\_>")) - (number (string-to-number (match-string 1))) - (repo (forge--repo-for-thingatpt))) + (and-let ((_(thing-at-point-looking-at "#\\([0-9]+\\)\\_>")) + (number (string-to-number (match-string 1))) + (repo (forge--repo-for-thingatpt))) (forge-get-issue repo number))) ;;; Read @@ -210,11 +211,11 @@ can be selected from the start." "Insert a list of issues, according to `forge--buffer-topics-spec'. Optional SPEC can be used to override that filtering specification, and optional HEADING to change the section heading." - (when-let (((forge-db t)) - (repo (forge-get-repository :tracked?)) - ((oref repo issues-p)) - (spec (if sspec spec (forge--clone-buffer-topics-spec))) - ((memq (oref spec type) '(topic issue)))) + (when-let* ((_(forge-db t)) + (repo (forge-get-repository :tracked?)) + (_(oref repo issues-p)) + (spec (if sspec spec (forge--clone-buffer-topics-spec))) + (_(memq (oref spec type) '(topic issue)))) (oset spec type 'issue) (forge--insert-topics 'issues (or heading "Issues") @@ -223,8 +224,10 @@ and optional HEADING to change the section heading." ;;; _ ;; Local Variables: ;; read-symbol-shorthands: ( -;; ("partial" . "llama--left-apply-partially") -;; ("rpartial" . "llama--right-apply-partially")) +;; ("and$" . "cond-let--and$") +;; ("and-let" . "cond-let--and-let") +;; ("if-let" . "cond-let--if-let") +;; ("when-let" . "cond-let--when-let")) ;; End: (provide 'forge-issue) ;;; forge-issue.el ends here diff --git a/elpa/forge-20250516.1009/forge-notify.el b/elpa/forge-20251201.1658/forge-notify.el similarity index 91% rename from elpa/forge-20250516.1009/forge-notify.el rename to elpa/forge-20251201.1658/forge-notify.el index 8956013a..3c30e70b 100644 --- a/elpa/forge-20250516.1009/forge-notify.el +++ b/elpa/forge-20251201.1658/forge-notify.el @@ -48,22 +48,22 @@ (cl-defmethod forge-get-repository ((notify forge-notification)) "Return the object for the repository that NOTIFY belongs to." - (and-let* ((id (oref notify repository))) + (and-let ((id (oref notify repository))) (closql-get (forge-db) id 'forge-repository))) (cl-defmethod forge-get-topic ((notify forge-notification)) - (and-let* ((repo (forge-get-repository notify))) + (and-let ((repo (forge-get-repository notify))) (forge-get-topic repo (oref notify topic)))) (cl-defmethod forge-get-notification ((id string)) (closql-get (forge-db) id 'forge-notification)) (cl-defmethod forge-get-notification ((topic forge-topic)) - (and-let* ((row (car (forge-sql [:select * :from notification - :where (and (= repository $s1) - (= topic $s2))] - (oref topic repository) - (oref topic number))))) + (and-let ((row (car (forge-sql [:select * :from notification + :where (and (= repository $s1) + (= topic $s2))] + (oref topic repository) + (oref topic number))))) (closql--remake-instance 'forge-notification (forge-db) row))) ;;;; Current @@ -73,8 +73,8 @@ If there is no such notification and DEMAND is non-nil, then signal an error." (or (magit-section-value-if 'notification) - (and-let* ((topic (forge-current-topic))) - (forge-get-notification topic)) + (and$ (forge-current-topic) + (forge-get-notification $)) (and demand (user-error "No current notification")))) (defun forge-notification-at-point (&optional demand) @@ -82,8 +82,8 @@ signal an error." If there is no such notification and DEMAND is non-nil, then signal an error." (or (magit-section-value-if 'notification) - (and-let* ((topic (forge-topic-at-point))) - (forge-get-notification topic)) + (and$ (forge-topic-at-point) + (forge-get-notification $)) (and demand (user-error "No notification at point")))) ;;;; List @@ -125,10 +125,10 @@ signal an error." (magit-hack-dir-local-variables)) (defun forge-notifications-setup-buffer () - (magit-setup-buffer-internal #'forge-notifications-mode nil - '((default-directory "/") - (forge-buffer-unassociated-p t)) - (get-buffer-create "*forge-notifications*"))) + (magit-setup-buffer #'forge-notifications-mode nil + :buffer (get-buffer-create "*forge-notifications*") + (default-directory "/") + (forge-buffer-unassociated-p t))) (defun forge-notifications-refresh-buffer () (magit-set-header-line-format (forge-notifications-buffer-desc)) @@ -308,7 +308,7 @@ signal an error." (magit-log--wash-summary (propertize title 'font-lock-face (if-let* ((topic (oref notif topic)) - ((eq (oref topic status) 'unread))) + (_(eq (oref topic status) 'unread))) 'forge-topic-unread 'forge-topic-open))))))) (_ @@ -322,8 +322,11 @@ signal an error." ;;; _ ;; Local Variables: ;; read-symbol-shorthands: ( -;; ("partial" . "llama--left-apply-partially") -;; ("rpartial" . "llama--right-apply-partially")) +;; ("and$" . "cond-let--and$") +;; ("and-let" . "cond-let--and-let") +;; ("if-let" . "cond-let--if-let") +;; ("when-let" . "cond-let--when-let") +;; ("partial" . "llama--left-apply-partially")) ;; End: (provide 'forge-notify) ;;; forge-notify.el ends here diff --git a/elpa/forge-20250516.1009/forge-pkg.el b/elpa/forge-20251201.1658/forge-pkg.el similarity index 50% rename from elpa/forge-20250516.1009/forge-pkg.el rename to elpa/forge-20251201.1658/forge-pkg.el index 4a50c38b..d59e109e 100644 --- a/elpa/forge-20250516.1009/forge-pkg.el +++ b/elpa/forge-20251201.1658/forge-pkg.el @@ -1,21 +1,21 @@ ;; -*- no-byte-compile: t; lexical-binding: nil -*- -(define-package "forge" "20250516.1009" +(define-package "forge" "20251201.1658" "Access Git forges from Magit." '((emacs "29.1") - (compat "30.0.2.0") - (closql "2.2.1") - (emacsql "4.3.0") - (ghub "4.3.0") - (let-alist "1.0.6") - (llama "0.6.2") - (magit "4.3.2") + (compat "30.1") + (closql "2.3") + (cond-let "0.2") + (emacsql "4.3") + (ghub "5.0") + (llama "1.0") + (magit "4.4") (markdown-mode "2.7") (seq "2.24") - (transient "0.8.7") - (yaml "1.2.0")) + (transient "0.10") + (yaml "1.2")) :url "https://github.com/magit/forge" - :commit "8e4dd7ed05212abb3f5318d1f2de5ef880d0d848" - :revdesc "8e4dd7ed0521" + :commit "325dbcd6fff652e28787950bada2484241dd3365" + :revdesc "325dbcd6fff6" :keywords '("git" "tools" "vc") :authors '(("Jonas Bernoulli" . "emacs.forge@jonas.bernoulli.dev")) :maintainers '(("Jonas Bernoulli" . "emacs.forge@jonas.bernoulli.dev"))) diff --git a/elpa/forge-20251201.1658/forge-post.el b/elpa/forge-20251201.1658/forge-post.el new file mode 100644 index 00000000..aef62819 --- /dev/null +++ b/elpa/forge-20251201.1658/forge-post.el @@ -0,0 +1,418 @@ +;;; forge-post.el --- Post support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2025 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . + +;;; Code: + +(require 'markdown-mode) + +(require 'forge) + +;;; Options + +(defcustom forge-post-mode-hook + '(visual-line-mode + turn-on-flyspell) + "Hook run after entering Forge-Post mode. +This hook is run early on while setting up a buffer to edit a post. +If you want to make changes to the already populated buffer, instead +use `forge-edit-post-hook'." + :package-version '(forge . "0.2.0") + :group 'forge + :type 'hook + :options '(visual-line-mode + turn-on-flyspell)) + +(defcustom forge-edit-post-hook + '(forge-create-pullreq-insert-single-commit-message + forge-create-pullreq-show-diff) + "Hook run after setting up a buffer to edit a post. +Consult the variable `forge-edit-post-action' to determine the action; +one of `new-discussion', `new-issue', `new-pullreq', `reply' and `edit'." + :package-version '(forge . "0.6.0") + :group 'forge + :type 'hook + :options '(forge-create-pullreq-insert-single-commit-message + forge-create-pullreq-insert-branch-description + forge-create-pullreq-show-diff)) + +(defcustom forge-post-fallback-directory + (locate-user-emacs-file "forge-drafts/") + "Directory used to store post drafts for locally unavailable repositories. +Normally drafts are stored inside the Git directory. If that does not +exist (or its location is unknown), then this directory is used instead." + :package-version '(forge . "0.4.7") + :group 'forge + :type 'directory) + +;;; Class + +(defclass forge-post (forge-object) () :abstract t) + +;;; Query +;;;; Get + +(cl-defmethod forge-get-parent ((post forge-post)) + (forge-get-topic post)) + +(cl-defmethod forge-get-repository ((post forge-post)) + (forge-get-repository (forge-get-topic post))) + +;;;; Current + +(defun forge-post-at-point (&optional assert) + "Return the post at point. +If there is no such post and DEMAND is non-nil, then signal +an error." + (or (magit-section-value-if '(issue pullreq post)) + (and assert (user-error "There is no post at point")))) + +(defun forge-comment-at-point (&optional assert) + "Return the comment at point. +If there is no such comment and DEMAND is non-nil, then signal +an error." + (or (and (magit-section-value-if '(post)) + (let ((post (oref (magit-current-section) value))) + (and (or (forge-pullreq-post-p post) + (forge-issue-post-p post)) + post))) + (and assert (user-error "There is no comment at point")))) + +;;; Utilities + +(cl-defmethod forge--format ((post forge-post) slot &optional spec) + (forge--format (forge-get-topic post) slot + `(,@spec (?I . ,(oref post number))))) + +;;; Mode + +(defvar-keymap forge-post-mode-map + " " #'forge-post-menu + "C-c C-e" #'forge-post-menu + "C-c C-c" #'forge-post-submit + " " #'forge-post-submit + " " #'forge-post-submit + "C-c C-k" #'forge-post-cancel + " " #'forge-post-cancel + " " #'forge-post-cancel + " " #'forge-post-cancel + " " #'forge-post-cancel) + +(define-derived-mode forge-post-mode gfm-mode "Forge-Post" + "Major mode for editing topic posts." + :interactive nil) + +(defvar-local forge--pre-post-buffer nil) +(defvar-local forge--pre-post-winconf nil) + +(defvar-local forge--submit-post-function nil) + +(defvar-local forge-edit-post-action nil + "The action being carried out by editing this post buffer. +One of `new-discussion', `new-issue', `new-pullreq', `reply' and `edit'.") + +(defvar-local forge--buffer-post-object nil) +(defvar-local forge--buffer-template nil) +(defvar-local forge--buffer-category nil) +(defvar-local forge--buffer-milestone nil) +(defvar-local forge--buffer-labels nil) +(defvar-local forge--buffer-assignees nil) +(defvar-local forge--buffer-base-branch nil) +(defvar-local forge--buffer-head-branch nil) +(defvar-local forge--buffer-draft-p nil) + +(defun forge--setup-post-buffer ( obj-or-action submit file header + &optional bindings fn) + (declare (indent defun)) + (let* ((prevbuf (current-buffer)) + (winconf (current-window-configuration)) + (action (cond ((symbolp obj-or-action) obj-or-action) + ((forge--childp obj-or-action 'forge-topic) 'reply) + ((forge--childp obj-or-action 'forge-post) 'edit))) + (obj (if (symbolp obj-or-action) + (forge-get-repository :tracked) + obj-or-action)) + (repo (forge-get-repository obj)) + (header (forge--format obj header)) + (file (forge--post-expand-file-name (forge--format obj file) repo)) + (_ (make-directory (file-name-directory file) t)) + (buffer (find-file-noselect file)) + (resume (forge--post-resume-p file buffer))) + (with-current-buffer buffer + (forge-post-mode) + (magit-set-header-line-format header) + (setq forge--pre-post-buffer prevbuf) + (setq forge--pre-post-winconf winconf) + (forge-set-buffer-repository) + (setq forge-edit-post-action action) + (setq forge--buffer-post-object obj) + (setq forge--submit-post-function submit) + (pcase-dolist (`(,var ,val) bindings) + (set (make-local-variable var) val) + (when (eq var 'forge--buffer-template) + (let-alist forge--buffer-template + (setq forge--buffer-assignees .assignees) + (setq forge--buffer-labels .labels) + (setq forge--buffer-draft-p .draft)))) + (cond-let + (resume) + ((not (memq action '(new-discussion new-issue new-pullreq)))) + ([template (alist-get 'text forge--buffer-template)] + (unless (string-prefix-p "# " template) + (insert "# \n\n")) + (insert template) + (goto-char 3)) + ((insert "# "))) + (when fn + (funcall fn))) + (run-hook-wrapped 'forge-edit-post-hook + (lambda (fn) (with-current-buffer buffer (funcall fn)) nil)) + (message (substitute-command-keys + "Use \\[forge-post-menu] to set fields and submit or abort")) + (forge--display-post-buffer buffer))) + +(defun forge--display-post-buffer (buf) + (magit-display-buffer buf #'display-buffer)) + +(defun forge--post-expand-file-name (file repo) + (if-let ((worktree (oref repo worktree))) + (expand-file-name (concat "magit/posts/" file) (magit-gitdir worktree)) + (expand-file-name (with-slots (githost owner name) repo + (format "%s_%s-%s_%s" githost owner name file)) + forge-post-fallback-directory))) + +(defun forge--post-resume-p (file buffer) + (and (file-exists-p file) + (> (file-attribute-size (file-attributes file)) 0) + (progn (forge--display-post-buffer buffer) + (or (magit-read-char-case "" nil + (?r "[r]esume editing this draft" t) + (?d "[d]iscard and start over?")) + (progn (erase-buffer) + nil))))) + +(defun forge-create-pullreq-insert-single-commit-message () + "When creating a pull-request from a single commit, insert its message." + (when-let* ((source forge--buffer-head-branch) + (target forge--buffer-base-branch) + (_(= (car (magit-rev-diff-count source target)) 1))) + (when (alist-get 'text forge--buffer-template) + (goto-char (point-max)) + (unless (eq (char-before) ?\n) + (insert ?\n)) + (insert "\n\n\n")) + (magit-rev-insert-format "%B" source) + (when (= (char-before (1- (point))) ?\n) + (delete-char -1)) + (goto-char 3))) + +(defun forge-create-pullreq-insert-branch-description () + "When creating a pull-request, insert branch description, if any. +Insert the value of `branch.BRANCH.description' of the source BRANCH." + (when-let* ((source forge--buffer-head-branch) + (description (magit-get "branch" + (cdr (magit-split-branch-name source)) + "description"))) + (when (or (alist-get 'text forge--buffer-template) + (> (point-max) 3)) + (goto-char (point-max)) + (unless (eq (char-before) ?\n) + (insert ?\n)) + (insert "\n\n\n")) + (insert description) + (goto-char 3))) + +(defun forge-create-pullreq-show-diff () + "When creating a pull-request, show diff for the branch's changes." + (when (eq forge-edit-post-action 'new-pullreq) + (magit-diff-setup-buffer + (format "%s...%s" + forge--buffer-base-branch + forge--buffer-head-branch) + nil (car (magit-diff-arguments)) nil 'committed t))) + +(defun forge--post-buffer-text () + (save-match-data + (save-excursion + (goto-char (point-min)) + (skip-chars-forward "\s\t\n") + (let (title body) + (when (looking-at "^#*[\s\t]*") + (goto-char (match-end 0))) + (setq title (buffer-str (point) (line-end-position))) + (forward-line) + (setq body (buffer-str (point))) + (cons (string-trim title) + (string-trim body)))))) + +(defun forge--post-submit-callback (&optional full-pull) + (let* ((file buffer-file-name) + (winconf forge--pre-post-winconf) + (editbuf (current-buffer)) + (prevbuf forge--pre-post-buffer) + (topic (ignore-errors (forge-get-topic forge--buffer-post-object))) + (repo (forge-get-repository (or topic forge--buffer-post-object)))) + (lambda (value &optional 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))) + (forge--maybe-restore-winconf winconf) + (with-current-buffer + (if (buffer-live-p prevbuf) prevbuf (current-buffer)) + (if (or (not full-pull) + (oref repo selective-p)) + (forge--pull-topic repo topic) + (forge--pull repo)))))) + +(defun forge--post-submit-errorback () + (lambda (error &rest _) + (error "Failed to submit post: %S" error))) + +(defun forge--maybe-restore-winconf (winconf) + (when (and winconf + (eq (window-configuration-frame winconf) + (selected-frame))) + (set-window-configuration winconf))) + +;;; Commands + +(transient-define-prefix forge-post-menu () + "Dispatch a post creation command." + [["Set" + :if (lambda () + (and (forge-github-repository-p (forge-get-repository :tracked)) + (string-prefix-p "new-" + (file-name-nondirectory buffer-file-name)))) + ("-m" forge-new-topic-set-milestone) + ("-l" forge-new-topic-set-labels) + ("-a" forge-new-topic-set-assignees) + ("-d" forge-new-pullreq-toggle-draft)] + ["Actions" + ("C-c" "Submit" forge-post-submit) + ("C-k" "Cancel" forge-post-cancel)]]) + +(defun forge-post-submit () + "Submit the post that is being edited in the current buffer." + (interactive) + (save-buffer) + (funcall forge--submit-post-function + (forge-get-repository forge--buffer-post-object) + forge--buffer-post-object)) + +(defun forge-post-cancel () + "Cancel the post that is being edited in the current buffer." + (interactive) + (save-buffer) + (let ((winconf forge--pre-post-winconf)) + (when (yes-or-no-p "Also delete draft? ") + (dired-delete-file buffer-file-name nil magit-delete-by-moving-to-trash)) + (magit-mode-bury-buffer 'kill) + (forge--maybe-restore-winconf winconf))) + +(defclass forge--new-topic-set-slot-command (transient-lisp-variable) + ((name :initarg :name) + (reader :initarg :reader) + (formatter :initarg :formatter) + (format :initform " %k %d") + (description :initform (lambda (obj) + (with-slots (name variable formatter) obj + (if-let* ((value (symbol-value variable)) + (value (funcall formatter value))) + (format "%s %s" name value) + (format "%s" name))))))) + +(transient-define-infix forge-new-topic-set-milestone () + "Set milestone for the topic being created." + :class 'forge--new-topic-set-slot-command + :variable 'forge--buffer-milestone + :name "milestone" + :reader (lambda (&rest _) (forge-read-topic-milestone)) + :formatter (lambda (milestone) (propertize milestone 'face 'forge-topic-label)) + :if (lambda () (equal (file-name-nondirectory buffer-file-name) "new-issue"))) + +(transient-define-infix forge-new-topic-set-labels () + "Set labels for the topic being created." + :class 'forge--new-topic-set-slot-command + :variable 'forge--buffer-labels + :name "labels" + :reader (lambda (&rest _) (forge-read-topic-labels)) + :formatter (##forge--format-labels % t) + :if (lambda () (equal (file-name-nondirectory buffer-file-name) "new-issue"))) + +(transient-define-infix forge-new-topic-set-assignees () + "Set assignees for the pull-request being created." + :class 'forge--new-topic-set-slot-command + :variable 'forge--buffer-assignees + :name "assignees" + :reader (lambda (&rest _) (forge-read-topic-assignees)) + :formatter #'forge--format-topic-assignees + :if (lambda () (equal (file-name-nondirectory buffer-file-name) "new-issue"))) + +(transient-define-infix forge-new-pullreq-toggle-draft () + "Toggle whether the pull-request being created is a draft." + :class 'forge--new-topic-set-slot-command + :variable 'forge--buffer-draft-p + :name "draft" + :reader (lambda (&rest _) (not forge--buffer-draft-p)) + :description (lambda () + (format (propertize "[%s]" 'face 'transient-delimiter) + (propertize "draft" 'face + (if forge--buffer-draft-p + 'transient-value + 'transient-inactive-value)))) + :if (lambda () (equal (file-name-nondirectory buffer-file-name) "new-pullreq"))) + +;;; Notes + +(defclass forge-note (forge-post) ()) + +(defvar-keymap forge-note-section-map + " " #'forge-edit-topic-note) + +(defun forge--save-note (_repo topic) + (let ((value (string-trim (buffer-str)))) + (oset topic note (if (equal value "") nil value))) + (delete-file buffer-file-name t) + (let ((dir (file-name-directory buffer-file-name))) + (unless (cddr (directory-files dir nil nil t)) + (delete-directory dir))) + (let ((prevbuf forge--pre-post-buffer)) + (magit-mode-bury-buffer 'kill) + (forge-refresh-buffer prevbuf))) + +;;; _ +;; Local Variables: +;; read-symbol-shorthands: ( +;; ("and$" . "cond-let--and$") +;; ("and-let" . "cond-let--and-let") +;; ("if-let" . "cond-let--if-let") +;; ("when-let" . "cond-let--when-let") +;; ("buffer-string" . "buffer-string") +;; ("buffer-str" . "forge--buffer-substring-no-properties")) +;; End: +(provide 'forge-post) +;;; forge-post.el ends here diff --git a/elpa/forge-20250516.1009/forge-pullreq.el b/elpa/forge-20251201.1658/forge-pullreq.el similarity index 85% rename from elpa/forge-20250516.1009/forge-pullreq.el rename to elpa/forge-20251201.1658/forge-pullreq.el index eb8bad02..630d1cd7 100644 --- a/elpa/forge-20250516.1009/forge-pullreq.el +++ b/elpa/forge-20251201.1658/forge-pullreq.el @@ -138,13 +138,14 @@ pullreq) (cl-defmethod forge-get-pullreq ((repo forge-repository) number) + (cl-assert (numberp number) t) (closql-get (forge-db) (forge--object-id 'forge-pullreq repo number) 'forge-pullreq)) (cl-defmethod forge-get-pullreq ((number integer)) - (and-let* ((repo (forge-get-repository :tracked nil 'notatpt))) - (forge-get-pullreq repo number))) + (and$ (forge-get-repository :tracked nil 'notatpt) + (forge-get-pullreq $ number))) (cl-defmethod forge-get-pullreq ((id string)) (closql-get (forge-db) id 'forge-pullreq)) @@ -185,12 +186,12 @@ an error." (put 'forge-pullreq 'thing-at-point #'forge-thingatpt--pullreq) (defun forge-thingatpt--pullreq () - (and-let* (((thing-at-point-looking-at "\\([#!]\\)\\([0-9]+\\)\\_>")) + (and-let* ((_(thing-at-point-looking-at "\\([#!]\\)\\([0-9]+\\)\\_>")) (prefix (match-string-no-properties 1)) (number (string-to-number (match-string-no-properties 2))) (repo (forge--repo-for-thingatpt)) - ((or (equal prefix "#") - (forge-gitlab-repository--eieio-childp repo)))) + (_(or (equal prefix "#") + (forge-gitlab-repository--eieio-childp repo)))) (forge-get-pullreq repo number))) ;;; Read @@ -238,7 +239,7 @@ can be selected from the start." (and (magit-rev-verify ref) ref))) (defun forge--pullreq-range (pullreq &optional endpoints) - (and-let* ((head (forge--pullreq-ref pullreq))) + (and-let ((head (forge--pullreq-ref pullreq))) (concat (forge--get-remote) "/" (oref pullreq base-ref) (if endpoints "..." "..") head))) @@ -263,10 +264,10 @@ can be selected from the start." "Insert a list of pull-requests, according to `forge--buffer-topics-spec'. Optional SPEC can be used to override that filtering specification, and optional HEADING to change the section heading." - (when-let (((forge-db t)) - (repo (forge-get-repository :tracked?)) - (spec (if sspec spec (forge--clone-buffer-topics-spec))) - ((memq (oref spec type) '(topic pullreq)))) + (when-let* ((_(forge-db t)) + (repo (forge-get-repository :tracked?)) + (spec (if sspec spec (forge--clone-buffer-topics-spec))) + (_(memq (oref spec type) '(topic pullreq)))) (oset spec type 'pullreq) (forge--insert-topics 'pullreqs (or heading "Pull requests") @@ -274,29 +275,33 @@ and optional HEADING to change the section heading." (defun forge--insert-pullreq-commits (pullreq &optional all) (cl-letf (((symbol-function #'magit-cancel-section) (lambda ()))) - (if all - ;; Numeric pr ref, pr branch (if it exists) and api - ;; pr range may be out of sync. Just show them all. - (magit-insert-section-body - (magit--insert-log nil - (delq nil (list (concat "^" (or (oref pullreq base-rev) - (concat (forge--get-remote) "/" - (oref pullreq base-ref)))) - (forge--pullreq-ref pullreq) - (forge--pullreq-branch-active pullreq) - (and-let* ((branch (oref pullreq head-ref))) - (and (magit-local-branch-p branch) branch)))) - (seq-uniq (cons "--graph" magit-buffer-log-args)))) - (when-let ((range (forge--pullreq-range pullreq))) - (magit-insert-section-body - (magit--insert-log nil range magit-buffer-log-args) - (magit-make-margin-overlay nil t)))))) + (cond-let + (all + ;; Numeric pr ref, pr branch (if it exists) and api + ;; pr range may be out of sync. Just show them all. + (magit-insert-section-body + (magit--insert-log nil + (delq nil (list (concat "^" (or (oref pullreq base-rev) + (concat (forge--get-remote) "/" + (oref pullreq base-ref)))) + (forge--pullreq-ref pullreq) + (forge--pullreq-branch-active pullreq) + (and-let* ((branch (oref pullreq head-ref)) + (_(magit-local-branch-p branch))) + branch))) + (seq-uniq (cons "--graph" magit-buffer-log-args))))) + ([range (forge--pullreq-range pullreq)] + (magit-insert-section-body + (magit--insert-log nil range magit-buffer-log-args) + (magit-make-margin-overlay nil t)))))) ;;; _ ;; Local Variables: ;; read-symbol-shorthands: ( -;; ("partial" . "llama--left-apply-partially") -;; ("rpartial" . "llama--right-apply-partially")) +;; ("and$" . "cond-let--and$") +;; ("and-let" . "cond-let--and-let") +;; ("if-let" . "cond-let--if-let") +;; ("when-let" . "cond-let--when-let")) ;; End: (provide 'forge-pullreq) ;;; forge-pullreq.el ends here diff --git a/elpa/forge-20250516.1009/forge-repo.el b/elpa/forge-20251201.1658/forge-repo.el similarity index 66% rename from elpa/forge-20250516.1009/forge-repo.el rename to elpa/forge-20251201.1658/forge-repo.el index 0612809e..9667a144 100644 --- a/elpa/forge-20250516.1009/forge-repo.el +++ b/elpa/forge-20251201.1658/forge-repo.el @@ -124,9 +124,14 @@ (car remotes)))) (when (and warn config remote (not (equal config remote))) (message "Ignored forge.remote=%s; no such remote.\nSee %s." config - "https://magit.vc/manual/forge/How-Forge-Detection-Works.html")) + "https://docs.magit.vc/forge/How-Forge-Detection-Works.html")) remote)) +(defun forge--get-default-branch (repo) + (let ((default-directory (forge-get-worktree repo))) + (concat (forge--get-remote) "/" + (or (oref repo default-branch) "master")))) + (cl-defmethod forge-get-repository ((_(eql :id)) id) (closql-get (forge-db) (substring-no-properties id) 'forge-repository)) @@ -146,46 +151,46 @@ then return that repository. Otherwise return the repository for `default-directory', if that exists and satisfies DEMAND. If that fails too, then return nil or signal an error, depending on DEMAND." - (or (and-let* ((repo (and (not notatpt) - (forge-repository-at-point)))) + (or (and-let ((_(not notatpt)) + (repo (forge-repository-at-point))) (forge-get-repository repo 'noerror demand)) - (and-let* ((repo (or (forge-buffer-repository) - (and forge-buffer-topic - (forge-get-repository forge-buffer-topic))))) + (and-let ((_(not remote)) + (repo (or (forge-buffer-repository) + (and forge-buffer-topic + (forge-get-repository forge-buffer-topic))))) (forge-get-repository repo 'noerror demand)) (magit--with-refresh-cache (list default-directory 'forge-get-repository demand) - (if (not (magit-gitdir)) - (when (memq demand forge--signal-no-entry) - (error - "Cannot determine Forge repository outside of Git repository")) - (unless remote - (setq remote (forge--get-remote 'warn))) - (if-let ((url (and remote - (magit-git-string "remote" "get-url" remote)))) - (and-let* ((repo (forge-get-repository url remote demand))) - (progn ; work around debbugs#31840 - (oset repo worktree (magit-toplevel)) - repo)) - (when (memq demand forge--signal-no-entry) - (error - "Cannot determine forge repository. %s\nSee %s." - (cond (remote (format "No url configured for %S." remote)) - ((and-let* ((config (magit-get "forge.remote"))) - (format "Value of `forge.remote' is %S but %s" - config "that remote does not exist."))) - ((magit-list-remotes) "Cannot decide on remote to use.") - (t "No remote configured.")) - "https://magit.vc/manual/forge/How-Forge-Detection-Works.html" - ))))))) + (cond-let + ((not (magit-gitdir)) + (when (memq demand forge--signal-no-entry) + (error + "Cannot determine Forge repository outside of Git repository"))) + [[remote (or remote (forge--get-remote 'warn))]] + ([_ remote] + [url (magit-git-string "remote" "get-url" remote)] + (and$ (forge-get-repository url remote demand) + (prog1 $ (oset $ worktree (magit-toplevel))))) + ((memq demand forge--signal-no-entry) + (error + "Cannot determine forge repository. %s\nSee %s." + (cond (remote (format "No url configured for %S." remote)) + ((and$ (magit-get "forge.remote") + (format "Value of `forge.remote' is %S but %s" + $ "that remote does not exist."))) + ((magit-list-remotes) "Cannot decide on remote to use.") + (t "No remote configured.")) + "https://docs.magit.vc/forge/How-Forge-Detection-Works.html" + )))))) (cl-defmethod forge-get-repository ((url string) &optional remote demand) "Return the repository at URL." - (if-let ((parts (forge--split-forge-url url))) - (forge-get-repository parts remote (or demand :known?)) - (when (memq demand forge--signal-no-entry) - (error "Cannot determine forge repository. %s isn't a forge URL. %s" - url "You might have to customize `forge-alist'.")))) + (cond-let + ([parts (forge--split-forge-url url)] + (forge-get-repository parts remote (or demand :known?))) + ((memq demand forge--signal-no-entry) + (error "Cannot determine forge repository. %s isn't a forge URL. %s" + url "You might have to customize `forge-alist'.")))) (cl-defmethod forge-get-repository (((host owner name) list) &optional remote demand) @@ -196,75 +201,75 @@ See `forge-alist' for valid Git hosts." (setq host (substring-no-properties host)) (setq owner (substring-no-properties owner)) (setq name (substring-no-properties name)) - (unless (memq demand '( :tracked :tracked? - :known? :insert! :valid? - :stub :stub?)) - (if-let ((new (pcase demand - ('t :tracked) - ('full :tracked?) - ('nil :known?) - ('create :insert!) - ('stub :stub) - ('maybe :stub?)))) - (progn - (message "Obsolete value for `%s's DEMAND: `%s'; use `%s' instead" - 'forge-get-repository demand new) - (setq demand new)) - (error "Unknown value for `%s's DEMAND: `%s'" - 'forge-get-repository demand))) - (if-let ((spec (forge--get-forge-host host t))) - (pcase-let ((`(,githost ,apihost ,webhost ,class) spec)) - ;; The `webhost' is used to identify the corresponding forge. - ;; For that reason it is stored in the `forge' slot. The id - ;; stored in the `id' slot also derives from that value. - (let* ((row (car (forge-sql [:select * :from repository - :where (and (= forge $s1) - (= owner $s2) - (= name $s3))] - webhost owner name))) - (obj (and row (closql--remake-instance class (forge-db) row)))) - ;; Synchronize the object with the entry from `forge-alist'. - ;; This only has an effect if the entry was modified, which - ;; should rarely, if ever, happen. Avoid confusion, by not - ;; mentioning this detail in any docstring. - (when obj - (oset obj apihost apihost) - (oset obj githost githost) - (oset obj remote remote)) - (pcase (list demand (and obj (eq (oref obj condition) :tracked))) - (`(:tracked? nil) (setq obj nil)) - (`(:tracked nil) - (error "Cannot use `%s' in %S yet.\n%s" - this-command (magit-toplevel) - "Use `M-x forge-add-repository' before trying again."))) - (when (and (memq demand '(:insert! :valid? :stub :stub?)) - (not obj)) - (pcase-let ((`(,id . ,forge-id) - (forge--repository-ids - class webhost owner name - (memq demand '(:stub :stub?)) - (eq demand :valid?)))) - (if (not id) - ;; `:valid?' was used and it turned out it is not. - (setq obj nil) - ;; The repo might have been renamed on the forge. #188 - (unless (setq obj (forge-get-repository :id id)) - (setq obj (funcall class - :id id - :forge-id forge-id - :forge webhost - :owner owner - :name name - :apihost apihost - :githost githost - :remote remote)) - (when (eq demand :insert!) - (closql-insert (forge-db) obj) - (oset obj condition :known)))))) - obj)) - (when (memq demand forge--signal-no-entry) - (error "Cannot determine forge repository. No entry for %S in %s" - host 'forge-alist)))) + (cond-let + ((memq demand '(:tracked :tracked? :known? :insert! :valid? :stub :stub?))) + ([corrected (pcase demand + ('t :tracked) + ('full :tracked?) + ('nil :known?) + ('create :insert!) + ('stub :stub) + ('maybe :stub?))] + (message "Obsolete value for `%s's DEMAND: `%s'; use `%s' instead" + 'forge-get-repository demand corrected) + (setq demand corrected)) + ((error "Unknown value for `%s's DEMAND: `%s'" + 'forge-get-repository demand))) + (cond-let + ([spec (forge--get-forge-host host t)] + (pcase-let* + ;; The `webhost' is used to identify the corresponding forge. + ;; For that reason it is stored in the `forge' slot. The id + ;; stored in the `id' slot also derives from that value. + ((`(,githost ,apihost ,webhost ,class) spec) + (row (car (forge-sql [:select * :from repository + :where (and (= forge $s1) + (= owner $s2) + (= name $s3))] + webhost owner name))) + (obj (and row (closql--remake-instance class (forge-db) row)))) + ;; Synchronize the object with the entry from `forge-alist'. + ;; This only has an effect if the entry was modified, which + ;; should rarely, if ever, happen. Avoid confusion, by not + ;; mentioning this detail in any docstring. + (when obj + (oset obj apihost apihost) + (oset obj githost githost) + (oset obj remote remote)) + (pcase (list demand (and obj (eq (oref obj condition) :tracked))) + (`(:tracked? nil) (setq obj nil)) + (`(:tracked nil) + (error "Cannot use `%s' in %S yet.\n%s" + this-command (magit-toplevel) + "Use `M-x forge-add-repository' before trying again."))) + (when (and (memq demand '(:insert! :valid? :stub :stub?)) + (not obj)) + (pcase-let ((`(,id . ,forge-id) + (forge--repository-ids + class webhost owner name + (memq demand '(:stub :stub?)) + (eq demand :valid?)))) + (if (not id) + ;; `:valid?' was used and it turned out it is not. + (setq obj nil) + ;; The repo might have been renamed on the forge. #188 + (unless (setq obj (forge-get-repository :id id)) + (setq obj (funcall class + :id id + :forge-id forge-id + :forge webhost + :owner owner + :name name + :apihost apihost + :githost githost + :remote remote)) + (when (eq demand :insert!) + (closql-insert (forge-db) obj) + (oset obj condition :known)))))) + obj)) + ((memq demand forge--signal-no-entry) + (error "Cannot determine forge repository. No entry for %S in %s" + host 'forge-alist)))) (cl-defmethod forge-get-repository ((repo forge-repository) &optional noerror demand) @@ -304,33 +309,33 @@ See `forge-alist' for valid Git hosts." If there is no such repository and DEMAND is non-nil, then signal an error." (or (magit-section-value-if 'forge-repo) - (and-let* ((topic (forge-topic-at-point))) + (and-let ((topic (forge-topic-at-point))) (forge-get-repository topic)) - (and (derived-mode-p 'forge-repository-list-mode) - (and-let* ((id (tabulated-list-get-id))) - (forge-get-repository :id id))) - (and (derived-mode-p 'magit-repolist-mode) - (and-let* ((dir (tabulated-list-get-id))) - (forge-get-repository :dir dir))) + (and-let ((_(derived-mode-p 'forge-repository-list-mode)) + (id (tabulated-list-get-id))) + (forge-get-repository :id id)) + (and-let ((_(derived-mode-p 'magit-repolist-mode)) + (dir (tabulated-list-get-id))) + (forge-get-repository :dir dir)) (and demand (user-error "No repository at point")))) (defun forge--repo-for-thingatpt () (or (magit-section-value-if 'forge-repo) - (and-let* ((topic (magit-section-value-if '(issue pullreq)))) + (and-let ((topic (magit-section-value-if '(issue pullreq)))) (forge-get-repository topic)) (and (not forge-buffer-unassociated-p) (or (forge-buffer-repository) (forge-get-repository :known? nil 'notatpt))))) (defun forge-buffer-repository () - (and-let* ((id forge-buffer-repository)) + (and-let ((id forge-buffer-repository)) (forge-get-repository :id id))) (defun forge-set-buffer-repository () "Initialize the value of variable `forge-buffer-repository'." (unless forge-buffer-repository - (and-let* ((repo (forge-get-repository :known?))) - (setq forge-buffer-repository (oref repo id))))) + (and$ (forge-get-repository :known?) + (setq forge-buffer-repository (oref $ id))))) (add-hook 'magit-mode-hook #'forge-set-buffer-repository) @@ -340,16 +345,16 @@ If `default-directory' is within one of REPO's worktrees, record that location in its `worktree' slot and return it. Otherwise, if a worktree has been recorded before, validate that. If it still is a worktree of REPO, return it, else set the slot to nil and return nil." - (if-let (((forge-repository-equal - repo (forge-get-repository :dir default-directory))) - (current-tree (magit-toplevel))) - (oset repo worktree current-tree) - (and-let* ((saved-tree (oref repo worktree))) - (and (file-accessible-directory-p saved-tree) - (if (forge-repository-equal - repo (forge-get-repository :dir saved-tree)) - saved-tree - (oset repo worktree nil)))))) + (cond-let* + ([_(forge-repository-equal + repo (forge-get-repository :dir default-directory))] + [current-tree (magit-toplevel)] + (oset repo worktree current-tree)) + ([saved-tree (oref repo worktree)] + [_(file-accessible-directory-p saved-tree)] + (if (forge-repository-equal repo (forge-get-repository :dir saved-tree)) + saved-tree + (oset repo worktree nil))))) ;;;; List @@ -433,11 +438,11 @@ forges and hosts." (forge-sql [:select [githost owner name] :from repository])) nil t nil nil - (and-let* ((default (forge-get-repository :stub?))) - (format "%s/%s @%s" - (oref default owner) - (oref default name) - (oref default githost)))))) + (and$ (forge-get-repository :stub?) + (format "%s/%s @%s" + (oref $ owner) + (oref $ name) + (oref $ githost)))))) (save-match-data (if (string-match "\\`\\(.+\\)/\\([^/]+\\) @\\(.+\\)\\'" choice) (forge-get-repository (list (match-string 3 choice) @@ -486,31 +491,6 @@ forges and hosts." (?p . ,path) (?P . ,(string-replace "/" "%2F" path)))))) -(defun forge--set-field-callback (topic &optional preserve-status) - (let ((status (oref topic status))) - (lambda (&rest _) - (forge--pull-topic - (forge-get-repository topic) - topic - :callback (lambda () - ;; Necessary when setting a discussion field because - ;; the API provides even less information about the - ;; status of discussions compared to other topics and - ;; as a result we would otherwise always switch the - ;; status to `unread'. This is not needed for every - ;; modification of a discussion because some of them - ;; (e.g., setting labels) do not cause `updated_at' to - ;; be bumped; this second defect cancels out the first - ;; when it comes to this function. - (when preserve-status - (oset topic status status)) - (forge-refresh-buffer) - (when (transient-active-prefix - '(forge-topic-menu - forge-topics-menu - forge-notifications-menu)) - (transient--refresh-transient))))))) - (defvar forge--mode-line-buffer nil) (defun forge--msg (repo echo done format &rest args) @@ -544,14 +524,9 @@ forges and hosts." (defun forge--ghub-type-symbol (class) (pcase-exhaustive class - ;; This package does not define a `forge-gitlab-http-repository' - ;; class, but we used to suggest at #9 that users define such a class - ;; if they must connect to a Gitlab instance that uses http instead - ;; of https. Doing that isn't necessary anymore, but we have to keep - ;; supporting it here. It is now sufficient to add an entry to - ;; `ghub-insecure-hosts'. - ((or 'forge-gitlab-repository 'forge-gitlab-http-repository) 'gitlab) ('forge-github-repository 'github) + ('forge-gitlab-repository 'gitlab) + ('forge-forgejo-repository 'forgejo) ('forge-gitea-repository 'gitea) ('forge-gogs-repository 'gogs) ('forge-bitbucket-repository 'bitbucket))) @@ -559,8 +534,11 @@ forges and hosts." ;;; _ ;; Local Variables: ;; read-symbol-shorthands: ( -;; ("partial" . "llama--left-apply-partially") -;; ("rpartial" . "llama--right-apply-partially")) +;; ("and$" . "cond-let--and$") +;; ("and-let" . "cond-let--and-let") +;; ("if-let" . "cond-let--if-let") +;; ("when-let" . "cond-let--when-let") +;; ("partial" . "llama--left-apply-partially")) ;; End: (provide 'forge-repo) ;;; forge-repo.el ends here diff --git a/elpa/forge-20250516.1009/forge-repos.el b/elpa/forge-20251201.1658/forge-repos.el similarity index 95% rename from elpa/forge-20250516.1009/forge-repos.el rename to elpa/forge-20251201.1658/forge-repos.el index 141440af..6d4b1ce9 100644 --- a/elpa/forge-20250516.1009/forge-repos.el +++ b/elpa/forge-20251201.1658/forge-repos.el @@ -143,10 +143,11 @@ Must be set before `forge-list' is loaded.") :if-non-nil forge--buffer-list-filter :inapt-if-mode nil)]] (interactive) - (unless (derived-mode-p 'forge-repository-list-mode) - (if-let ((buffer (get-buffer forge-repository-list-buffer-name))) - (switch-to-buffer buffer) - (forge-list-repositories))) + (cond-let + ((derived-mode-p 'forge-repository-list-mode)) + ([buffer (get-buffer forge-repository-list-buffer-name)] + (switch-to-buffer buffer)) + ((forge-list-repositories))) (transient-setup 'forge-repositories-menu)) (transient-augment-suffix forge-repositories-menu @@ -189,8 +190,10 @@ Only Github is supported for now." ;;; _ ;; Local Variables: ;; read-symbol-shorthands: ( -;; ("partial" . "llama--left-apply-partially") -;; ("rpartial" . "llama--right-apply-partially")) +;; ("and$" . "cond-let--and$") +;; ("and-let" . "cond-let--and-let") +;; ("if-let" . "cond-let--if-let") +;; ("when-let" . "cond-let--when-let")) ;; End: (provide 'forge-repos) ;;; forge-repos.el ends here diff --git a/elpa/forge-20250516.1009/forge-revnote.el b/elpa/forge-20251201.1658/forge-revnote.el similarity index 90% rename from elpa/forge-20250516.1009/forge-revnote.el rename to elpa/forge-20251201.1658/forge-revnote.el index cf7ba848..673b411d 100644 --- a/elpa/forge-20250516.1009/forge-revnote.el +++ b/elpa/forge-20251201.1658/forge-revnote.el @@ -45,8 +45,10 @@ ;;; _ ;; Local Variables: ;; read-symbol-shorthands: ( -;; ("partial" . "llama--left-apply-partially") -;; ("rpartial" . "llama--right-apply-partially")) +;; ("and$" . "cond-let--and$") +;; ("and-let" . "cond-let--and-let") +;; ("if-let" . "cond-let--if-let") +;; ("when-let" . "cond-let--when-let")) ;; End: (provide 'forge-revnote) ;;; forge-revnote.el ends here diff --git a/elpa/forge-20250516.1009/forge-semi.el b/elpa/forge-20251201.1658/forge-semi.el similarity index 100% rename from elpa/forge-20250516.1009/forge-semi.el rename to elpa/forge-20251201.1658/forge-semi.el diff --git a/elpa/forge-20250516.1009/forge-tablist.el b/elpa/forge-20251201.1658/forge-tablist.el similarity index 94% rename from elpa/forge-20250516.1009/forge-tablist.el rename to elpa/forge-20251201.1658/forge-tablist.el index 0b4ab813..2cc25b21 100644 --- a/elpa/forge-20250516.1009/forge-tablist.el +++ b/elpa/forge-20251201.1658/forge-tablist.el @@ -79,8 +79,10 @@ ;;; _ ;; Local Variables: ;; read-symbol-shorthands: ( -;; ("partial" . "llama--left-apply-partially") -;; ("rpartial" . "llama--right-apply-partially")) +;; ("and$" . "cond-let--and$") +;; ("and-let" . "cond-let--and-let") +;; ("if-let" . "cond-let--if-let") +;; ("when-let" . "cond-let--when-let")) ;; End: (provide 'forge-tablist) ;;; forge-tablist.el ends here diff --git a/elpa/forge-20250516.1009/forge-topic.el b/elpa/forge-20251201.1658/forge-topic.el similarity index 88% rename from elpa/forge-20250516.1009/forge-topic.el rename to elpa/forge-20251201.1658/forge-topic.el index f835c8ee..69a292ab 100644 --- a/elpa/forge-20250516.1009/forge-topic.el +++ b/elpa/forge-20251201.1658/forge-topic.el @@ -22,6 +22,7 @@ ;;; Code: +(require 'bookmark) (require 'bug-reference) (require 'eieio-custom) (require 'markdown-mode) @@ -336,24 +337,27 @@ A face attribute should be used that is not already used by any topic) (cl-defmethod forge-get-topic ((repo forge-repository) number-or-id) - (if (and (numberp number-or-id) - (< number-or-id 0)) - (forge-get-pullreq repo (abs number-or-id)) - (or (forge-get-discussion number-or-id) - (forge-get-issue number-or-id) - (forge-get-pullreq number-or-id)))) + (cond ((stringp number-or-id) + (or (forge-get-discussion number-or-id) + (forge-get-issue number-or-id) + (forge-get-pullreq number-or-id))) + ((< number-or-id 0) + (forge-get-pullreq repo (abs number-or-id))) + ((forge-get-discussion repo number-or-id)) + ((forge-get-issue repo number-or-id)) + ((forge-get-pullreq repo number-or-id)))) (cl-defmethod forge-get-topic ((number integer)) (if (< number 0) (forge-get-pullreq (abs number)) (or (forge-get-discussion number) - (forge-get-issue number) - (forge-get-pullreq number)))) + (forge-get-issue number) + (forge-get-pullreq number)))) (cl-defmethod forge-get-topic ((id string)) (or (forge-get-discussion id) - (forge-get-issue id) - (forge-get-pullreq id))) + (forge-get-issue id) + (forge-get-pullreq id))) ;;;; Current @@ -376,10 +380,10 @@ an error." (put 'forge-topic 'thing-at-point #'forge-thingatpt--topic) (defun forge-thingatpt--topic () - (and-let* (((thing-at-point-looking-at "\\([#!]\\)\\([0-9]+\\)\\_>")) - (prefix (match-string-no-properties 1)) - (number (string-to-number (match-string-no-properties 2))) - (repo (forge--repo-for-thingatpt))) + (and-let ((_(thing-at-point-looking-at "\\([#!]\\)\\([0-9]+\\)\\_>")) + (prefix (match-string-no-properties 1)) + (number (string-to-number (match-string-no-properties 2))) + (repo (forge--repo-for-thingatpt))) (cond ((equal prefix "#") (forge-get-topic repo number)) ((forge-gitlab-repository--eieio-childp repo) @@ -852,7 +856,7 @@ can be selected from the start." (let ((crm-separator ",")) (magit-completing-read-multiple "Labels: " - (forge--format-labels (and obj (forge-get-repository obj))) + (forge--format-labels (forge-get-repository (or obj :tracked))) nil t (and (cl-typep obj 'forge-topic) (forge--format-labels obj crm-separator))))) @@ -918,8 +922,8 @@ can be selected from the start." ,(pcase state ('open 'forge-topic-slug-open) ((or 'completed 'merged) 'forge-topic-slug-completed) - ((or 'unplanned 'duplicate 'rejected) - 'forge-topic-slug-unplanned)))))) + ((or 'unplanned 'outdated 'duplicate 'rejected) + 'forge-topic-slug-expunged)))))) (defun forge--format-topic-refs (topic) (pcase-let @@ -963,7 +967,7 @@ can be selected from the start." ,(pcase (list (eieio-object-class topic) state) (`(forge-discussion open) 'forge-discussion-open) (`(forge-discussion completed) 'forge-discussion-completed) - (`(forge-discussion unplanned) 'forge-discussion-expunged) + (`(forge-discussion outdated) 'forge-discussion-expunged) (`(forge-discussion duplicate) 'forge-discussion-expunged) (`(forge-issue open) 'forge-issue-open) (`(forge-issue completed) 'forge-issue-completed) @@ -978,18 +982,18 @@ can be selected from the start." (defun forge--format-topic-category (topic) (and-let* ((id (oref topic category)) - (str (caar (forge-sql [:select [name] - :from discussion-category - :where (= id $s1)] - id)))) + (str (forge-sql1 [:select [name] + :from discussion-category + :where (= id $s1)] + id))) (magit--propertize-face str 'forge-topic-label))) (defun forge--format-topic-milestone (topic) (and-let* ((id (oref topic milestone)) - (str (caar (forge-sql [:select [title] - :from milestone - :where (= id $s1)] - id)))) + (str (forge-sql1 [:select [title] + :from milestone + :where (= id $s1)] + id))) (magit--propertize-face str 'forge-topic-label))) (defun forge--format-labels (&optional arg concat) @@ -1028,17 +1032,17 @@ can be selected from the start." (mapcar format labels)))) (defun forge--format-marks (&optional arg concat) - (and-let* ((marks (if (forge-topic--eieio-childp arg) - (oref arg marks) - ;; Unlike labels, marks are not repo-specific. - (when (forge-repository-p arg) (setq arg nil)) - (forge-sql-cdr `[:select * :from mark - ,@(and arg '(:where (in name $v1))) - :order-by [(asc name)]] - (vconcat arg)))) - (format (pcase-lambda (`(,_id ,name ,face ,_description)) - (magit--propertize-face - name (list face 'forge-topic-label))))) + (and-let ((marks (if (forge-topic--eieio-childp arg) + (oref arg marks) + ;; Unlike labels, marks are not repo-specific. + (when (forge-repository-p arg) (setq arg nil)) + (forge-sql-cdr `[:select * :from mark + ,@(and arg '(:where (in name $v1))) + :order-by [(asc name)]] + (vconcat arg)))) + (format (pcase-lambda (`(,_id ,name ,face ,_description)) + (magit--propertize-face + name (list face 'forge-topic-label))))) (if concat (mapconcat format marks (if (stringp concat) concat " ")) (mapcar format marks)))) @@ -1050,7 +1054,7 @@ can be selected from the start." (pcase (list (if (forge-issue-p topic) 'issue 'pullreq) state) ('(discussion open) 'forge-discussion-open) ('(discussion completed) 'forge-discussion-completed) - ('(discussion unplanned) 'forge-discussion-expunged) + ('(discussion outdated) 'forge-discussion-expunged) ('(discussion duplicate) 'forge-discussion-expunged) ('(issue open) 'forge-issue-open) ('(issue completed) 'forge-issue-completed) @@ -1069,19 +1073,31 @@ can be selected from the start." ('pending 'forge-topic-pending) ('done 'forge-topic-done))))) -(defun forge--format-topic-assignees (topic) - (and-let* ((assignees (oref topic assignees))) +(defun forge--format-topic-assignees (arg) + (and-let ((assignees + (cond ((eieio-object-p arg) + (oref arg assignees)) + ((forge-buffer-repository) + (forge-sql-cdr [:select * :from assignee + :where + (and (= repository $s1) + (in login $v2)) + :order-by [(asc login)]] + forge-buffer-repository + (vconcat arg)))))) (mapconcat #'forge--format-person assignees ", "))) (defun forge--format-topic-review-requests (topic) - (and-let* ((review-requests (oref topic review-requests))) - (mapconcat #'forge--format-person review-requests ", "))) + (and$ (oref topic review-requests) + (mapconcat #'forge--format-person $ ", "))) (defun forge--format-person (person) - (pcase-let ((`(,_id ,login ,name) person)) - (format "%s%s (@%s)" - (forge--format-avatar login) - name login))) + (pcase-let* ((`(,_id ,login ,name) person) + (avatar (forge--format-avatar login))) + (propertize (if name + (format "%s%s (@%s)" avatar name login) + (format "%s@%s" avatar login)) + 'face 'transient-value))) (defun forge--format-avatar (person) (if forge-format-avatar-function @@ -1106,11 +1122,11 @@ can be selected from the start." "Insert a list of topics, according to PREPARE. This function is not intended to be added to section hooks directly. -Instead create a function, which calls this function, and add wrapper -to the section hook. +Instead create a function, which calls this function, and add that +wrapper to the mode's section hook. PREPARE is a function which takes one arguments the repository object, -and must return an filter object of type `forge--topics-spec' or nil. +and must return a filter object of type `forge--topics-spec' or nil. Insert no topics if PREPARE returns nil, or if the current repository isn't tracked or Forge hasn't been fully setup yet (in the latter two cases don't even call PREPARE). @@ -1123,11 +1139,31 @@ See `forge--topics-spec' for the valid slots and their values. HEADING is used as the heading of the list section and TYPE is used as its type. TYPE should be a symbol of the form `SUBSET-KIND', where KIND is one of `topics', `issues' or `pullreqs', and SUBSET should describe -what subset of KIND is being listed." +what subset of KIND is being listed. + +For example, to insert a list of issues assigned to you use something +like: + + (defun my-forge-insert-assigned-issues () + \"Insert a list of issues that are assigned to me.\" + (forge-insert-topics \\='assigned-issues \"Assigned issues\" + (lambda (repo) + (and-let* ((me (ghub--username repo))) + (forge--topics-spec :type \\='issue :active t + :assignee me))))) + + (magit-add-section-hook \\='magit-status-sections-hook + #\\='my-forge-insert-assigned-issues + #\\='forge-insert-issues) + +Grep Forge for more examples. + +Alternatively you can use `forge-topics-setup-buffer' to list a set +of topics in a dedicated buffer." (declare (indent defun)) - (when-let (((forge-db t)) - (repo (forge-get-repository :tracked?)) - (spec (funcall prepare repo))) + (when-let* ((_(forge-db t)) + (repo (forge-get-repository :tracked?)) + (spec (funcall prepare repo))) (forge--insert-topics type heading (forge--list-topics spec repo)))) (defun forge--insert-topics (type heading topics) @@ -1161,7 +1197,7 @@ what subset of KIND is being listed." (forge--insert-pullreq-commits topic))))) (defun forge--insert-topic-labels (topic &optional separate) - (and-let* ((labels (oref topic labels))) + (and-let ((labels (oref topic labels))) (prog1 t (pcase-dolist (`(,_id ,name ,color ,description) labels) (let* ((background (forge--sanitize-color color)) @@ -1179,7 +1215,7 @@ what subset of KIND is being listed." (overlay-put o 'help-echo description)))))))) (defun forge--insert-topic-marks (topic &optional separate) - (and-let* ((marks (oref topic marks))) + (and-let ((marks (oref topic marks))) (prog1 t (pcase-dolist (`(,_id ,name ,face ,description) marks) (if separate (insert " ") (setq separate t)) @@ -1285,15 +1321,17 @@ This mode itself is never used directly." (defun forge-topic-setup-buffer (topic) (let* ((repo (forge-get-repository topic)) (name (format "*forge: %s %s*" (oref repo slug) (oref topic slug))) - (magit-generate-buffer-name-function (lambda (_mode _value) name))) - (magit-setup-buffer-internal - (pcase-exhaustive (eieio-object-class topic) - ('forge-discussion #'forge-discussion-mode) - ('forge-issue #'forge-issue-mode) - ('forge-pullreq #'forge-pullreq-mode)) - t `((forge-buffer-topic ,topic)) - name (or (forge-get-worktree repo) "/")) - (forge-topic-mark-read topic))) + (magit-generate-buffer-name-function (lambda (_mode _value) name)) + (mode (pcase-exhaustive (eieio-object-class topic) + ('forge-discussion #'forge-discussion-mode) + ('forge-issue #'forge-issue-mode) + ('forge-pullreq #'forge-pullreq-mode))) + (buffer (magit-setup-buffer mode t + :buffer name + :directory (or (forge-get-worktree repo) "/") + (forge-buffer-topic topic)))) + (forge-topic-mark-read topic) + buffer)) (defun forge-topic-refresh-buffer () (let ((topic (closql-reload forge-buffer-topic))) @@ -1301,8 +1339,10 @@ This mode itself is never used directly." (magit-set-header-line-format (forge--format-topic-line topic)) (magit-insert-section (topicbuf) (magit-insert-headers - (intern (format "%s-headers-hook" - (substring (symbol-name major-mode) 0 -5)))) + (pcase major-mode + ('forge-discussion-mode 'forge-discussion-headers-hook) + ('forge-issue-mode 'forge-issue-headers-hook) + ('forge-pullreq-mode 'forge-pullreq-headers-hook))) (when (forge-pullreq-p topic) (magit-insert-section (pullreq topic) (magit-insert-heading "Commits") @@ -1351,15 +1391,15 @@ This mode itself is never used directly." (setq heading (concat " " heading))) (font-lock-append-text-property 0 (length heading) - 'font-lock-face (cond - ((and (forge-discussion-p topic) - (and-let* ((answer (oref topic answer))) - (equal (oref post their-id) - (forge--their-id answer)))) - 'forge-discussion-answer-heading) - ((forge-discussion-reply-p post) - '(magit-dimmed magit-diff-hunk-heading)) - ('magit-diff-hunk-heading)) + 'font-lock-face (cond-let* + ([_(forge-discussion-p topic)] + [answer (oref topic answer)] + [_(equal (oref post their-id) + (forge--their-id answer))] + 'forge-discussion-answer-heading) + ((forge-discussion-reply-p post) + '(magit-dimmed magit-diff-hunk-heading)) + ('magit-diff-hunk-heading)) heading) (magit-insert-heading heading))) @@ -1372,6 +1412,28 @@ This mode itself is never used directly." (cl-defmethod magit-buffer-value (&context (major-mode forge-topic-mode)) (oref forge-buffer-topic slug)) +;;; Bookmarks + +(cl-defmethod magit-bookmark-name + (&context (major-mode forge-topic-mode)) + (concat (oref (forge-get-repository forge-buffer-topic) slug) + (oref forge-buffer-topic slug))) + +(cl-defmethod magit-bookmark-get-value + (bookmark &context (major-mode forge-topic-mode)) + (bookmark-prop-set bookmark 'forge-topic (oref forge-buffer-topic id))) + +(cl-defmethod magit-bookmark-get-buffer-create + (bookmark (_mode (derived-mode forge-topic-mode))) + (let ((magit-display-buffer-function #'identity) + (magit-display-buffer-noselect t)) + (forge-topic-setup-buffer + (forge-get-topic (bookmark-prop-get bookmark 'forge-topic))))) + +(put 'forge-discussion-mode 'magit-bookmark-variables t) +(put 'forge-issue-mode 'magit-bookmark-variables t) +(put 'forge-pullreq-mode 'magit-bookmark-variables t) + ;;; Headers (cl-defmacro forge--define-topic-header @@ -1439,6 +1501,8 @@ This mode itself is never used directly." ;;; Commands ;;;; Groups +(defvar forge--show-topic-legend t) + (transient-define-group forge--lists-group ["List" ("l r" "repositories" forge-list-repositories) @@ -1493,8 +1557,6 @@ This mode itself is never used directly." ["" :if-non-nil forge--show-topic-legend (:info* (##propertize "draft" 'face 'forge-pullreq-draft))]) -(defvar forge--show-topic-legend t) - (transient-define-suffix forge-toggle-topic-legend () "Toggle whether to show legend for faces used in topic menus and lists." :description (##if forge--show-topic-legend "hide legend" "show legend") @@ -1596,9 +1658,9 @@ This mode itself is never used directly." (inapt-face :initform (lambda (obj) (with-slots (getter state) (transient-suffix-object) - (if (and (not (forge-region-topics)) - (and-let* ((topic (funcall getter))) - (eq (oref topic state) state))) + (if (and-let ((_(not (forge-region-topics))) + (topic (funcall getter))) + (eq (oref topic state) state)) 'forge-suffix-active 'transient-inapt-suffix)))))) @@ -1659,17 +1721,17 @@ inferior process." (if (magit-read-char-case (format "Merge #%s " (oref pullreq number)) t (?g "using [g]it (recommended)" t) (?a "using [a]pi" nil)) - (if-let ((branch (or (forge--pullreq-branch-active pullreq) - (forge--branch-pullreq pullreq))) - (upstream (magit-get-local-upstream-branch branch))) - (if (zerop (magit-call-git "checkout" upstream)) - (magit--merge-absorb - branch (magit-merge-arguments) - ;; Users might be surprised that we - ;; aren't done yet, so drop a hint. - "Inspect the result, and if satisfied push") - (user-error "Could not checkout %S" upstream)) - (user-error "No upstream configured for %S" branch)) + (let ((branch (or (forge--pullreq-branch-active pullreq) + (forge--branch-pullreq pullreq)))) + (if-let ((upstream (magit-get-local-upstream-branch branch))) + (if (zerop (magit-call-git "checkout" upstream)) + (magit--merge-absorb + branch (magit-merge-arguments) + ;; Users might be surprised that we + ;; aren't done yet, so drop a hint. + "Inspect the result, and if satisfied push") + (user-error "Could not checkout %S" upstream)) + (user-error "No upstream configured for %S" branch))) (forge-merge pullreq (forge-select-merge-method))))) (transient-define-suffix forge-pullreq-state-set-rejected () @@ -1821,7 +1883,13 @@ inferior process." "Mark the post at point as the answer to the current question. When point is on the answer, then unmark it and mark no other." :class 'forge--topic-set-slot-command :slot 'answer - :inapt-if-not #'forge-current-discussion + :inapt-if-not (lambda () + (and-let* ((discussion (forge-current-discussion)) + (category (oref discussion category))) + (forge-sql1 [:select answerable-p + :from discussion-category + :where (= id $s1)] + category))) :description (##forge--format-boolean 'answer "answered") :reader #'forge--select-discussion-answer) @@ -1848,7 +1916,16 @@ When point is on the answer, then unmark it and mark no other." (fill-region (point-min) (point-max))) (when indent (indent-rigidly (point-min) (point-max) indent)) - (buffer-string))) + (let* ((string (buffer-string)) + (beg 0) + (end (length string))) + (while (< beg end) + (let ((pos (next-single-property-change beg 'face string end)) + (val (get-text-property beg 'face string))) + (put-text-property beg pos 'font-lock-face val string) + (remove-list-of-text-properties beg pos '(face) string) + (setq beg pos))) + string))) (defun forge--markdown-translate-filename-function (file) (if (string-match-p "\\`https?://" file) @@ -1862,6 +1939,8 @@ When point is on the answer, then unmark it and mark no other." ;;; Templates (defun forge--topic-template (repo class) + (unless repo + (setq repo (forge-get-repository :tracked))) (let* ((templates (forge--topic-templates repo class)) (template (if (cdr templates) @@ -1890,14 +1969,14 @@ When point is on the answer, then unmark it and mark no other." (magit-git-insert "cat-file" "-p" file) (if (equal (file-name-nondirectory file) "config.yml") (forge--topic-parse-template-config) - (list (forge--topic-parse-template))))) + (list (forge--topic-parse-template (file-name-base file)))))) (forge--topic-template-files repo class))) (cl-defgeneric forge--topic-template-files (repo class)) (defun forge--topic-template-files-1 (repo suffix &rest paths) (setq suffix (ensure-list suffix)) - (let ((branch (oref repo default-branch))) + (let ((branch (forge--get-default-branch repo))) (seq-keep (if suffix (##and (member (file-name-extension %) suffix) (concat branch ":" %)) @@ -1908,7 +1987,7 @@ When point is on the answer, then unmark it and mark no other." branch "--" paths)))) (defun forge--topic-parse-template-config () - (let-alist (yaml-parse-string (magit--buffer-string) + (let-alist (yaml-parse-string (buffer-str) :object-type 'alist :sequence-type 'list) (nconc @@ -1922,86 +2001,45 @@ When point is on the answer, then unmark it and mark no other." " — " .about))))) .contact_links)))) -(defun forge--topic-parse-template () +(defun forge--topic-parse-template (name) (goto-char (point-min)) (skip-chars-forward "\s\t\n\r") (if-let ((beg (and (looking-at "^---[\s\t]*$") (point))) (end (and (zerop (forward-line)) (re-search-forward "^---[\s\t]*$" nil t) - (match-beginning 0)))) - (let-alist (yaml-parse-string (magit--buffer-string beg end) + (match-beginning 0))) + (repoid (oref (forge-get-repository :tracked) id))) + (let-alist (yaml-parse-string (buffer-str beg end) :object-type 'alist :sequence-type 'list - :null-object nil) - `((prompt . ,(format "%s — %s" (propertize .name 'face 'bold) .about)) - (title . ,(and .title (string-trim .title))) - (text . ,(magit--buffer-string (point) nil ?\n)) - (labels . ,(ensure-list .labels)) - (assignees . ,(ensure-list .assignees)))) - `((text . ,(magit--buffer-string))))) - -(defun forge--topic-parse-buffer (&optional file) - (save-match-data - (save-excursion - (goto-char (point-min)) - (let ((alist (save-excursion (forge--topic-parse-yaml)))) - (if alist - (setf (alist-get 'yaml alist) t) - (setq alist (save-excursion (forge--topic-parse-plain)))) - (setf (alist-get 'file alist) file) - (setf (alist-get 'text alist) (magit--buffer-string nil nil ?\n)) - (when (and file (not (alist-get 'prompt alist))) - (setf (alist-get 'prompt alist) - (file-name-sans-extension (file-name-nondirectory file)))) - ;; If there is a yaml front-matter, then it is supposed - ;; to have a `title' field, but this may not be the case. - (when (and (not file) - (not (alist-get 'title alist))) - (setf (alist-get 'title alist) - (read-string "Title: "))) - alist)))) - -(defun forge--topic-parse-yaml () - (let (alist beg end) - (when (looking-at "^---[\s\t]*$") - (forward-line) - (setq beg (point)) - (when (re-search-forward "^---[\s\t]*$" nil t) - (setq end (match-beginning 0)) - (setq alist (yaml-parse-string (magit--buffer-string beg end) - :object-type 'alist - :sequence-type 'list - :false-object nil)) - (let-alist alist - (when (and .name .about) - (setf (alist-get 'prompt alist) - (format "%s -- %s" .name .about))) - (when (and .labels (atom .labels)) - (setf (alist-get 'labels alist) (list .labels))) - (when (and .assignees (atom .assignees)) - (setf (alist-get 'assignees alist) (list .assignees)))) - (forward-line) - (when (and (not (alist-get 'title alist)) - (looking-at "^\n?#*")) - (goto-char (match-end 0)) - (setf (alist-get 'title alist) - (string-trim - (magit--buffer-string (point) (line-end-position) t))) - (forward-line)) - (setf (alist-get 'body alist) - (string-trim (magit--buffer-string (point) nil ?\n))))) - alist)) - -(defun forge--topic-parse-plain () - (let (title body) - (when (looking-at "\\`#*") - (goto-char (match-end 0))) - (setq title (magit--buffer-string (point) (line-end-position) t)) - (forward-line) - (setq body (magit--buffer-string (point) nil ?\n)) - `((title . ,(string-trim title)) - (body . ,(string-trim body))))) + :null-object nil + :false-object nil) + (when (stringp .name) + (setq name .name)) + (setq name (propertize .name 'face 'bold)) + `((prompt . ,(if .about (format "%s — %s" name .about) name)) + (title . ,(and .title + (stringp .title) + (string-trim .title))) + (text . ,(string-trim (buffer-str (point)))) + ;; Prevent ad hock creation or previously unknown labels. + (labels . ,(cl-intersection + (ensure-list .labels) + (forge-sql-car [:select name :from label + :where (= repository $s1)] + repoid) + :test #'equal)) + ;; Server errors on invalid assignees. + (assignees . ,(cl-intersection + (ensure-list .assignees) + (forge-sql-car [:select login :from assignee + :where (= repository $s1)] + repoid) + :test #'equal)) + (draft . ,(and (booleanp .draft) .draft)))) + `((prompt . ,(propertize name 'face 'bold)) + (text . ,(string-trim (buffer-str)))))) ;;; Bug-Reference @@ -2045,13 +2083,18 @@ modify `bug-reference-bug-regexp' if appropriate." (unless noninteractive (dolist (hook forge-bug-reference-hooks) - (add-hook hook #'forge-bug-reference-setup))) + (add-hook hook #'forge-bug-reference-setup t))) ;;; _ ;; Local Variables: ;; read-symbol-shorthands: ( -;; ("partial" . "llama--left-apply-partially") -;; ("rpartial" . "llama--right-apply-partially")) +;; ("and$" . "cond-let--and$") +;; ("and-let" . "cond-let--and-let") +;; ("if-let" . "cond-let--if-let") +;; ("when-let" . "cond-let--when-let") +;; ("buffer-string" . "buffer-string") +;; ("buffer-str" . "forge--buffer-substring-no-properties") +;; ("partial" . "llama--left-apply-partially")) ;; End: (provide 'forge-topic) ;;; forge-topic.el ends here diff --git a/elpa/forge-20250516.1009/forge-topics.el b/elpa/forge-20251201.1658/forge-topics.el similarity index 91% rename from elpa/forge-20250516.1009/forge-topics.el rename to elpa/forge-20251201.1658/forge-topics.el index 35d1f334..14f225a0 100644 --- a/elpa/forge-20250516.1009/forge-topics.el +++ b/elpa/forge-20251201.1658/forge-topics.el @@ -114,6 +114,46 @@ Must be set before `forge-topics' is loaded.") (magit-hack-dir-local-variables)) (defun forge-topics-setup-buffer (&optional repo spec &rest params) + "List a set of topics in a buffer. + +The buffer is determined using `forge-topics-buffer-name', which uses +the same buffer for all global lists, and likewise just one buffer per +repository for repository-local lists. You could use `cl-letf' to use +a different buffer for certain sets. + +If optional REPO is non-nil, it must be a `forge-repository' object. +It is only relevant when not showing a global topic list, as determined +by the value of `:global' in PARAMS. Even when showing a local list, +REPO may be nil, in that case the repository is determined from context. + +If optional SPEC is non-nil, it must be a `forge--topics-spec' object. +If nil, a clone of the existing filter spec from the buffer determined +above is used, provided that buffer already exists and has a local +filter spec. A clone of `forge-list-buffer-default-topic-filters' is +used otherwise. + +Optional PARAMS can be used to set slots of SPEC. PARAMS is a plist +where each key is an initarg for a slot of the `forge--topics-spec' +class. + +Usually you would use nil for SPEC, so that a clone of the currently +effective filter spec is used, and then you would set only some of +the available filters using PARAMS. + + (transient-define-suffix my-forge-list-assigned-issues () + \"List issues of the current repository that are assigned to me.\" + :description \"issues\" + (declare (interactive-only nil)) + (interactive) + (when-let* ((repo (forge-get-repository :tracked)) + (me (ghub--username repo))) + (forge-topics-setup-buffer repo nil :type \\='issue :assignee me) + (transient-setup \\='forge-topics-menu))) + +Grep Forge for more examples. + +Alternatively you can use `forge-insert-topics' list topics in, e.g., +the Magit status buffer." (let* ((global (or (plist-get params :global) (and spec (oref spec global)))) (repo (or repo @@ -130,19 +170,18 @@ Must be set before `forge-topics' is loaded.") (buffer-local-value 'forge--buffer-topics-spec buf))) ((clone forge-list-buffer-default-topic-filters))))) (while-let ((key (pop params))) - (eieio-oset spec key (pop params))) + (eieio-oset spec (intern (substring (symbol-name key) 1)) (pop params))) (unless (oref spec type) (oset spec type 'topic)) (forge--cast-topics-spec-state spec) (unless (or repo global) (error "Cannot determine repository")) - (magit-setup-buffer-internal #'forge-topics-mode nil - `((forge-buffer-repository - ,(and repo (oref repo id))) - (forge--buffer-topics-spec ,spec) - (forge-buffer-unassociated-p ,global)) - (get-buffer-create buf) - dir))) + (magit-setup-buffer #'forge-topics-mode nil + :buffer (get-buffer-create buf) + :directory dir + (forge-buffer-repository (and repo (oref repo id))) + (forge--buffer-topics-spec spec) + (forge-buffer-unassociated-p global)))) (defun forge-topics-refresh-buffer () (magit-set-header-line-format (forge-topics-buffer-desc)) @@ -161,9 +200,7 @@ Must be set before `forge-topics' is loaded.") (let ((repo (forge-get-repository (car topics)))) (magit-insert-section (forge-repo repo) (magit-insert-heading - (concat (propertize (format "%s/%s" - (oref repo owner) - (oref repo name)) + (concat (propertize (oref repo slug) 'font-lock-face 'bold) (format " (%s)" (length topics)))) (dolist (topic topics) @@ -686,8 +723,11 @@ Expunged topics include: ;;; _ ;; Local Variables: ;; read-symbol-shorthands: ( -;; ("partial" . "llama--left-apply-partially") -;; ("rpartial" . "llama--right-apply-partially")) +;; ("and$" . "cond-let--and$") +;; ("and-let" . "cond-let--and-let") +;; ("if-let" . "cond-let--if-let") +;; ("when-let" . "cond-let--when-let") +;; ("while-let" . "cond-let--while-let")) ;; End: (provide 'forge-topics) ;;; forge-topics.el ends here diff --git a/elpa/forge-20250516.1009/forge.el b/elpa/forge-20251201.1658/forge.el similarity index 92% rename from elpa/forge-20250516.1009/forge.el rename to elpa/forge-20251201.1658/forge.el index 758413b0..5d8da6d4 100644 --- a/elpa/forge-20250516.1009/forge.el +++ b/elpa/forge-20251201.1658/forge.el @@ -7,21 +7,21 @@ ;; Homepage: https://github.com/magit/forge ;; Keywords: git tools vc -;; Package-Version: 20250516.1009 -;; Package-Revision: 8e4dd7ed0521 +;; Package-Version: 20251201.1658 +;; Package-Revision: 325dbcd6fff6 ;; Package-Requires: ( -;; (emacs "29.1") -;; (compat "30.0.2.0") -;; (closql "2.2.1") -;; (emacsql "4.3.0") -;; (ghub "4.3.0") -;; (let-alist "1.0.6") -;; (llama "0.6.2") -;; (magit "4.3.2") +;; (emacs "29.1") +;; (compat "30.1") +;; (closql "2.3") +;; (cond-let "0.2") +;; (emacsql "4.3") +;; (ghub "5.0") +;; (llama "1.0") +;; (magit "4.4") ;; (markdown-mode "2.7") -;; (seq "2.24") -;; (transient "0.8.7") -;; (yaml "1.2.0")) +;; (seq "2.24") +;; (transient "0.10") +;; (yaml "1.2")) ;; SPDX-License-Identifier: GPL-3.0-or-later @@ -134,6 +134,9 @@ is loaded, then `magit-mode-map' ends up being modified anyway.") (transient-append-suffix 'magit-pull "m" '("n" forge-pull)) (transient-append-suffix 'magit-pull "n" '("N" forge-pull-notifications)) + (transient-insert-suffix 'magit-push "p" + '("N" forge-push-to-unnamed-pullreq)) + (transient-append-suffix 'magit-branch "w" '("f" "pull-request" forge-checkout-pullreq)) (transient-append-suffix 'magit-branch "W" @@ -184,10 +187,4 @@ too.\n" forge--minimal-git version) :error)))) (forge-startup-asserts) (add-hook 'after-init-hook #'forge-startup-asserts t)) -;;; _ -;; Local Variables: -;; read-symbol-shorthands: ( -;; ("partial" . "llama--left-apply-partially") -;; ("rpartial" . "llama--right-apply-partially")) -;; End: ;;; forge.el ends here diff --git a/elpa/forge-20250516.1009/forge.info b/elpa/forge-20251201.1658/forge.info similarity index 95% rename from elpa/forge-20250516.1009/forge.info rename to elpa/forge-20251201.1658/forge.info index fd0ac97c..abe7b175 100644 --- a/elpa/forge-20250516.1009/forge.info +++ b/elpa/forge-20251201.1658/forge.info @@ -27,7 +27,7 @@ Forge User and Developer Manual Forge allows you to work with Git forges, currently Github and Gitlab, from the comfort of Magit and Emacs. -This manual is for Forge version 0.5.0. +This manual is for Forge version 0.6.2. Copyright (C) 2018-2025 Jonas Bernoulli @@ -514,7 +514,7 @@ Tell Forge about the Instance A few hosts, which use partially supported forge types, are available out-of-the-box, because they have an entry in the default value of option ‘forge-alist’ (also see its docstring). For example, the entry -for in that variable looks like this: +for in that variable looks like this: ("codeberg.org" ; GITHOST "codeberg.org/api/v1" ; APIHOST @@ -831,6 +831,10 @@ status buffers, by adding the following functions to ‘forge-status-buffer-default-topic-filters’ and can be changed temporarily for the current buffer, using ‘N m f’ (‘forge-topics-menu’). + -- Function: forge-insert-discussions + This function inserts a list of discussions, by default a list of + "active" discussions. + -- Function: forge-insert-issues This function inserts a list of issues, by default a list of "active" issues. @@ -880,6 +884,13 @@ argument, i.e., ‘C-u RET’. These commands read a topic, issue or pull-request and visit it in a separate buffer. +‘N v u’ (‘forge-visit-topic-from-url’) + This commands reads an URL and visits the corresponding topic. + Normally users would yank that URL into the minibuffer, after + having copied it from an email or a browser’s address bar. + + This command is disabled in the menu by default. + ‘C-c C-o’ (‘forge-browse’) ‘o [on topic in topic list]’ (‘forge-browse-this-topic’) ‘o [on repository in repository list]’ (‘forge-browse-this-repository’) @@ -911,6 +922,10 @@ argument, i.e., ‘C-u RET’. region, instead use the branch name as part of the URL, unless a prefix argument is used. + When invoked from a Dired buffer, visit the blob at point without + prompting. If a prefix argument is used, the commit hash is + included in the URL. + When invoked from any other buffer, prompt the user for a branch or commit, and for a file. @@ -1013,7 +1028,7 @@ File: forge.info, Node: Pulling, Next: Branching, Prev: Editing Topics, Up: The commands that fetch forge data are available the Forge’s main menu (‘forge-dispatch’ on ‘N’) and from the same menu (‘magit-fetch’ on ‘f’) -that is used to fetch Git data. If ‘magit-pull-or-fetch’ is non-nil, +that is used to fetch Git data. If ‘magit-pull-or-fetch’ is non-‘nil’, then they are also available from the ‘magit-pull’ menu (on ‘F’). With Git you have to explicitly pull Git data to make it available in @@ -1116,44 +1131,33 @@ and check out branches and work trees in a more generic fashion to their personal fork, even if they have push access to the upstream, so ‘branch..pushRemote’ is set anyway. - • If the pull-request branch is located inside a fork, then you - are usually able to push to that branch, because Github by - default allows the recipient of a pull-request to push to the - remote pull-request branch even if it is located in a fork. - The contributor has to explicitly disable this. - - • If you are not allowed to push to the pull-request branch - on the fork, then a branch by the same name located in - the upstream repository is configured as the push-target. - - • A—sadly rather common—special case is when the - contributor didn’t bother to use a dedicated branch for - the pull-request. - - The most likely such case is when you are being asked to - merge something like "fork/master" into "origin/master". - The special push permission mentioned above is never - granted for the branch that is the repository’s default - branch, and that would almost certainly be the case in - this scenario. - - To enable you to easily push somewhere anyway, the local - branch is named "pr-N" (where ‘N’ is the pull-request - number) and the upstream repository is used as the - push-remote. - - • Finally, if you are allowed to push to the pull-request - branch and the contributor had the foresight to use a - dedicated branch, then the fork is configured as the - push-remote. - - The push-remote is configured using + • The push-remote is configured using ‘branch..pushRemote’, even if the used value is identical to that of ‘remote.pushDefault’, just in case you change the value of the latter later on. Additionally the variable ‘branch..pullRequestRemote’ is set to the remote on which the pull-request branch is located. + • If the pull-request branch is located on the contributor’s + fork, then you, as a maintainer of the upstream repository, + are usually allowed to push to that branch anyway. (However, + the contributor could explicitly disallow this, but in my + experience that rarely happens.) + + • As mentioned above, contributors sometimes fail to use a + dedicated branch for their pull-requests and this command is + thus forced to make up a branch name such as "pr-313". + + Usually a maintainer would use + ‘magit-push-current-to-pushremote’ (on ‘p’) to push to the + contributor’s pull-request branch on their fork. For a branch + named "pr-313" that does not work. (Instead of pushing to + "fork/main", it would unsuccessfully attempt to create a new + branch "pr-313" on the fork.) In such situations the + ‘magit-push’ menu offers an alternative command for pushing to + the pull-request branch: ‘forge-push-to-unnamed-pullreq’ (on + ‘N’). + ‘b f’ (‘forge-checkout-pullreq’) This command creates and configures a new branch from a pull-request the same way ‘forge-branch-pullreq’ does. @@ -1208,6 +1212,9 @@ File: forge.info, Node: Miscellaneous Commands, Next: Miscellaneous Options, Currently this only supports Github and Gitlab. + With a prefix argument, fork all branches, not just the default + branch. On Gitlab it is not possible to fork only the default. + ‘N - H’ (‘forge-toggle-topic-legend’) This command toggle whether to show a legend for faces used in topic menus and lists. @@ -1734,7 +1741,7 @@ Appendix D Keystroke Index * Menu: * b F: Branching. (line 13) -* b f: Branching. (line 102) +* b f: Branching. (line 91) * C- [on a topic section]: Editing Topics. (line 26) * C-c C-c: Creating Topics and Posts. (line 37) @@ -1755,31 +1762,31 @@ Appendix D Keystroke Index (line 23) * C-c C-n [on "Pull requests" section]: Creating Topics and Posts. (line 19) -* C-c C-o: Visiting Topics. (line 34) +* C-c C-o: Visiting Topics. (line 41) * C-c C-r: Creating Topics and Posts. (line 27) * C-c C-w: Miscellaneous Commands. - (line 37) + (line 40) * f n: Getting Started. (line 32) * f n <1>: Pulling. (line 23) * f N: Pulling. (line 34) * M b r: Miscellaneous Commands. - (line 45) + (line 48) * m M [if enabled]: Miscellaneous Commands. (line 8) * N: Getting Started. (line 50) * N <1>: Lists and Menus. (line 40) * N - H: Miscellaneous Commands. - (line 29) + (line 32) * N - S: Miscellaneous Commands. - (line 33) + (line 36) * N / a: Getting Started. (line 15) -* N b i: Visiting Topics. (line 46) -* N b I: Visiting Topics. (line 46) -* N b p: Visiting Topics. (line 46) -* N b P: Visiting Topics. (line 46) -* N b r: Visiting Topics. (line 46) -* N b t: Visiting Topics. (line 46) +* N b i: Visiting Topics. (line 53) +* N b I: Visiting Topics. (line 53) +* N b p: Visiting Topics. (line 53) +* N b P: Visiting Topics. (line 53) +* N b r: Visiting Topics. (line 53) +* N b t: Visiting Topics. (line 53) * N c f: Miscellaneous Commands. (line 21) * N c i: Creating Topics and Posts. @@ -1806,14 +1813,15 @@ Appendix D Keystroke Index * N v i: Visiting Topics. (line 28) * N v p: Visiting Topics. (line 28) * N v t: Visiting Topics. (line 28) +* N v u: Visiting Topics. (line 32) * o [in forge-repositories-menu]: Lists and Menus. (line 120) -* o [on repository in repository list]: Visiting Topics. (line 34) -* o [on topic in topic list]: Visiting Topics. (line 34) +* o [on repository in repository list]: Visiting Topics. (line 41) +* o [on topic in topic list]: Visiting Topics. (line 41) * RET [on "Issues" status section]: Lists and Menus. (line 66) * RET [on "Pull requests" status section]: Lists and Menus. (line 72) * RET [on repository]: Lists and Menus. (line 117) * RET [on topic]: Visiting Topics. (line 21) -* Z n: Branching. (line 107) +* Z n: Branching. (line 96)  File: forge.info, Node: Function and Command Index, Next: Variable Index, Prev: Keystroke Index, Up: Top @@ -1825,31 +1833,31 @@ Appendix E Function and Command Index * Menu: * forge-add-organization-repositories: Miscellaneous Commands. - (line 64) + (line 67) * forge-add-pullreq-refspec: Miscellaneous Commands. - (line 51) + (line 54) * forge-add-repository: Getting Started. (line 15) * forge-add-user-repositories: Miscellaneous Commands. - (line 58) + (line 61) * forge-branch-pullreq: Branching. (line 13) -* forge-browse: Visiting Topics. (line 34) -* forge-browse-branch: Visiting Topics. (line 38) -* forge-browse-commit: Visiting Topics. (line 37) -* forge-browse-commit <1>: Visiting Topics. (line 49) -* forge-browse-issue: Visiting Topics. (line 46) -* forge-browse-issues: Visiting Topics. (line 46) -* forge-browse-pullreq: Visiting Topics. (line 46) -* forge-browse-pullreqs: Visiting Topics. (line 46) -* forge-browse-remote: Visiting Topics. (line 46) -* forge-browse-repository: Visiting Topics. (line 39) -* forge-browse-this-repository: Visiting Topics. (line 34) -* forge-browse-this-topic: Visiting Topics. (line 34) -* forge-browse-topic: Visiting Topics. (line 46) -* forge-checkout-pullreq: Branching. (line 102) -* forge-checkout-worktree: Branching. (line 107) +* forge-browse: Visiting Topics. (line 41) +* forge-browse-branch: Visiting Topics. (line 45) +* forge-browse-commit: Visiting Topics. (line 44) +* forge-browse-commit <1>: Visiting Topics. (line 56) +* forge-browse-issue: Visiting Topics. (line 53) +* forge-browse-issues: Visiting Topics. (line 53) +* forge-browse-pullreq: Visiting Topics. (line 53) +* forge-browse-pullreqs: Visiting Topics. (line 53) +* forge-browse-remote: Visiting Topics. (line 53) +* forge-browse-repository: Visiting Topics. (line 46) +* forge-browse-this-repository: Visiting Topics. (line 41) +* forge-browse-this-topic: Visiting Topics. (line 41) +* forge-browse-topic: Visiting Topics. (line 53) +* forge-checkout-pullreq: Branching. (line 91) +* forge-checkout-worktree: Branching. (line 96) * forge-configure: Lists and Menus. (line 45) * forge-copy-url-at-point-as-kill: Miscellaneous Commands. - (line 37) + (line 40) * forge-create-issue: Creating Topics and Posts. (line 23) * forge-create-post: Creating Topics and Posts. @@ -1864,8 +1872,9 @@ Appendix E Function and Command Index (line 83) * forge-fork: Miscellaneous Commands. (line 21) -* forge-insert-issues: Lists and Menus. (line 184) -* forge-insert-pullreqs: Lists and Menus. (line 188) +* forge-insert-discussions: Lists and Menus. (line 184) +* forge-insert-issues: Lists and Menus. (line 188) +* forge-insert-pullreqs: Lists and Menus. (line 192) * forge-list-global-issues: Lists and Menus. (line 82) * forge-list-global-pullreqs: Lists and Menus. (line 87) * forge-list-global-topics: Lists and Menus. (line 78) @@ -1891,18 +1900,18 @@ Appendix E Function and Command Index * forge-pull-notifications: Pulling. (line 34) * forge-pull-topic: Pulling. (line 43) * forge-remove-repository: Miscellaneous Commands. - (line 71) + (line 74) * forge-remove-topic-locally: Miscellaneous Commands. - (line 75) + (line 78) * forge-rename-default-branch: Miscellaneous Commands. - (line 45) + (line 48) * forge-repositories-menu: Lists and Menus. (line 109) * forge-reset-database: Miscellaneous Commands. - (line 91) + (line 94) * forge-toggle-display-in-status-buffer: Miscellaneous Commands. - (line 33) + (line 36) * forge-toggle-topic-legend: Miscellaneous Commands. - (line 29) + (line 32) * forge-topic-menu: Editing Topics. (line 26) * forge-topics-menu: Lists and Menus. (line 53) * forge-visit-issue: Visiting Topics. (line 28) @@ -1910,6 +1919,7 @@ Appendix E Function and Command Index * forge-visit-this-repository: Lists and Menus. (line 117) * forge-visit-this-topic: Visiting Topics. (line 21) * forge-visit-topic: Visiting Topics. (line 28) +* forge-visit-topic-from-url: Visiting Topics. (line 32)  File: forge.info, Node: Variable Index, Prev: Function and Command Index, Up: Top @@ -1926,7 +1936,7 @@ Appendix F Variable Index (line 21) * forge-bug-reference-hooks: Miscellaneous Options. (line 58) -* forge-checkout-worktree-read-directory-function: Branching. (line 112) +* forge-checkout-worktree-read-directory-function: Branching. (line 101) * forge-database-file: Miscellaneous Options. (line 6) * forge-limit-topic-choices: Miscellaneous Options. @@ -1971,58 +1981,58 @@ Ref: Set your Username (3)15557 Ref: Create and Store an Access Token (3)15865 Node: Setup a Partially Supported Host18541 Ref: Tell Forge about the Instance (2)19226 -Ref: Add Support for Additional Forge Types20722 -Node: Initial Pull21893 -Node: Getting Started23100 -Node: Lists and Menus25386 -Ref: Dispatch and configuration menus27210 -Ref: Topic menu and list commands27669 -Ref: Notification menu and list commands29580 -Ref: Repository menu and list commands29988 -Ref: Exiting menus and lists31785 -Ref: Default topic filters32480 -Ref: Topic sections in Magit status buffers32918 -Node: Visiting Topics34149 -Node: Creating Topics and Posts37040 -Node: Editing Topics39122 -Node: Pulling40747 -Node: Branching42909 -Node: Miscellaneous Commands49302 -Node: Miscellaneous Options53266 -Node: How Forge Detection Works55730 -Node: Supported Forges and Hosts61267 -Node: Supported Forges62576 -Ref: Github62732 -Ref: Github Caveats62887 -Ref: Github Hosts63549 -Ref: Gitlab63621 -Ref: Gitlab Caveats63648 -Ref: Gitlab Hosts63789 -Node: Partially Supported Forges63925 -Ref: Forgejo https//forgejoorg64131 -Ref: Forgejo Hosts64253 -Ref: Gitea https//giteaio64329 -Ref: Gogs https//gogsio64553 -Ref: Bitbucket https//bitbucketorg64793 -Ref: Bitbucket Caveats65003 -Ref: Bitbucket Hosts65916 -Node: Supported Semi-Forges65997 -Ref: Gitweb https//git-scmcom/docs/gitweb66168 -Ref: Gitweb Caveats66259 -Ref: Cgit https//gitzx2c4com/cgit/about66515 -Ref: Cgit Caveats66604 -Ref: Cgit Hosts66969 -Ref: Stgit https//codemadnessorg/git/stagit/file/READMEhtml67112 -Ref: Stgit Caveats67241 -Ref: Stgit Hosts67543 -Ref: Srht https//metasrht67619 -Ref: Srht Caveats67680 -Ref: Srht Hosts67979 -Node: FAQ68046 -Node: error in process filter HTTP Error 502 "Bad gateway"68456 -Node: Keystroke Index69937 -Node: Function and Command Index75917 -Node: Variable Index82270 +Ref: Add Support for Additional Forge Types20724 +Node: Initial Pull21895 +Node: Getting Started23102 +Node: Lists and Menus25388 +Ref: Dispatch and configuration menus27212 +Ref: Topic menu and list commands27671 +Ref: Notification menu and list commands29582 +Ref: Repository menu and list commands29990 +Ref: Exiting menus and lists31787 +Ref: Default topic filters32482 +Ref: Topic sections in Magit status buffers32920 +Node: Visiting Topics34289 +Node: Creating Topics and Posts37648 +Node: Editing Topics39730 +Node: Pulling41355 +Node: Branching43523 +Node: Miscellaneous Commands49418 +Node: Miscellaneous Options53521 +Node: How Forge Detection Works55985 +Node: Supported Forges and Hosts61522 +Node: Supported Forges62831 +Ref: Github62987 +Ref: Github Caveats63142 +Ref: Github Hosts63804 +Ref: Gitlab63876 +Ref: Gitlab Caveats63903 +Ref: Gitlab Hosts64044 +Node: Partially Supported Forges64180 +Ref: Forgejo https//forgejoorg64386 +Ref: Forgejo Hosts64508 +Ref: Gitea https//giteaio64584 +Ref: Gogs https//gogsio64808 +Ref: Bitbucket https//bitbucketorg65048 +Ref: Bitbucket Caveats65258 +Ref: Bitbucket Hosts66171 +Node: Supported Semi-Forges66252 +Ref: Gitweb https//git-scmcom/docs/gitweb66423 +Ref: Gitweb Caveats66514 +Ref: Cgit https//gitzx2c4com/cgit/about66770 +Ref: Cgit Caveats66859 +Ref: Cgit Hosts67224 +Ref: Stgit https//codemadnessorg/git/stagit/file/READMEhtml67367 +Ref: Stgit Caveats67496 +Ref: Stgit Hosts67798 +Ref: Srht https//metasrht67874 +Ref: Srht Caveats67935 +Ref: Srht Hosts68234 +Node: FAQ68301 +Node: error in process filter HTTP Error 502 "Bad gateway"68711 +Node: Keystroke Index70192 +Node: Function and Command Index76245 +Node: Variable Index82744  End Tag Table -- 2.47.3