| 1 | ;;; magit-worktree.el --- Worktree support -*- lexical-binding:t -*- |
| 2 | |
| 3 | ;; Copyright (C) 2008-2026 The Magit Project Contributors |
| 4 | |
| 5 | ;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> |
| 6 | ;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> |
| 7 | |
| 8 | ;; SPDX-License-Identifier: GPL-3.0-or-later |
| 9 | |
| 10 | ;; Magit is free software: you can redistribute it and/or modify it |
| 11 | ;; under the terms of the GNU General Public License as published by |
| 12 | ;; the Free Software Foundation, either version 3 of the License, or |
| 13 | ;; (at your option) any later version. |
| 14 | ;; |
| 15 | ;; Magit is distributed in the hope that it will be useful, but WITHOUT |
| 16 | ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY |
| 17 | ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public |
| 18 | ;; License for more details. |
| 19 | ;; |
| 20 | ;; You should have received a copy of the GNU General Public License |
| 21 | ;; along with Magit. If not, see <https://www.gnu.org/licenses/>. |
| 22 | |
| 23 | ;;; Commentary: |
| 24 | |
| 25 | ;; This library implements support for `git-worktree'. |
| 26 | |
| 27 | ;;; Code: |
| 28 | |
| 29 | (require 'magit) |
| 30 | |
| 31 | ;;; Options |
| 32 | |
| 33 | (defcustom magit-read-worktree-directory-function |
| 34 | #'magit-read-worktree-directory-sibling |
| 35 | "Function used to read the directory to be used as a new worktree. |
| 36 | This is called with two arguments, the prompt and the commit to be |
| 37 | checked out." |
| 38 | :package-version '(magit . "4.4.0") |
| 39 | :group 'magit-commands |
| 40 | :type `(radio (function-item ,#'magit-read-worktree-directory) |
| 41 | (function-item ,#'magit-read-worktree-directory-nested) |
| 42 | (function-item ,#'magit-read-worktree-directory-sibling) |
| 43 | (function-item ,#'magit-read-worktree-directory-offsite) |
| 44 | function)) |
| 45 | |
| 46 | (defcustom magit-read-worktree-offsite-directory |
| 47 | (expand-file-name "wtrees/" (or (getenv "XDG_DATA_HOME") "~/.local/share")) |
| 48 | "Base directory used by `magit-read-worktree-directory-offsite'. |
| 49 | That function is suitable as `magit-read-worktree-directory-function', |
| 50 | but is not used by default." |
| 51 | :package-version '(magit . "4.4.0") |
| 52 | :group 'magit-commands |
| 53 | :type 'directory) |
| 54 | |
| 55 | (defvar magit-worktree-read-directory-name-function nil |
| 56 | "Like `magit-read-worktree-directory-function' but takes only one argument.") |
| 57 | (make-obsolete-variable 'magit-worktree-read-directory-name-function |
| 58 | 'magit-read-worktree-directory-function |
| 59 | "Magit 4.4.0") |
| 60 | |
| 61 | ;;; Functions |
| 62 | |
| 63 | (defun magit-read-worktree-directory (prompt _commit) |
| 64 | "Call `read-directory-name' with PROMPT, but ignoring _COMMIT." |
| 65 | (read-directory-name prompt)) |
| 66 | |
| 67 | (defun magit-read-worktree-directory-nested (prompt commit) |
| 68 | "Call `read-directory-name' in current worktree. |
| 69 | For `read-directory-name's INITIAL argument use a string based on |
| 70 | COMMIT, replacing slashes with dashes. If COMMIT is nil, use nil |
| 71 | as INITIAL. Always forward PROMPT as-is." |
| 72 | (read-directory-name prompt nil nil nil |
| 73 | (and commit (string-replace "/" "-" commit)))) |
| 74 | |
| 75 | (defun magit-read-worktree-directory-sibling (prompt commit) |
| 76 | "Call `read-directory-name' in parent directory of current worktree. |
| 77 | For `read-directory-name's INITIAL argument use a string based on the |
| 78 | name of the current worktree and BRANCH. Use \"PREFIX_BRANCH\" where |
| 79 | PREFIX is the name of the current worktree, up to the first underscore, |
| 80 | and slashes in COMMIT are replaced with dashes. If COMMIT is nil use |
| 81 | just \"PREFIX_\". Always forward PROMPT as-is." |
| 82 | (let* ((path (directory-file-name default-directory)) |
| 83 | (name (file-name-nondirectory path))) |
| 84 | (read-directory-name |
| 85 | prompt (file-name-directory path) nil nil |
| 86 | (concat (if (string-match "_" name) |
| 87 | (substring name 0 (match-beginning 0)) |
| 88 | name) |
| 89 | "_" |
| 90 | (and commit (string-replace "/" "-" commit)))))) |
| 91 | |
| 92 | (defun magit-read-worktree-directory-offsite (prompt commit) |
| 93 | "Call `read-directory-name' in a directory shared by all repositories. |
| 94 | |
| 95 | Option `magit-read-worktree-offsite-directory' specifies that shared |
| 96 | base directory. |
| 97 | |
| 98 | For `read-directory-name's INITIAL argument use a string based on the |
| 99 | name of the current worktree and BRANCH. Use \"PREFIX_BRANCH\" where |
| 100 | PREFIX is the name of the current worktree, up to the first underscore, |
| 101 | and slashes in COMMIT are replaced with dashes. If COMMIT is nil use |
| 102 | just \"PREFIX_\". Always forward PROMPT as-is." |
| 103 | (mkdir magit-read-worktree-offsite-directory t) |
| 104 | (read-directory-name |
| 105 | prompt magit-read-worktree-offsite-directory nil nil |
| 106 | (let* ((name (file-name-nondirectory (directory-file-name default-directory))) |
| 107 | (name (if (string-match "_" name) |
| 108 | (substring name 0 (match-beginning 0)) |
| 109 | name)) |
| 110 | (name (concat name "_"))) |
| 111 | (if commit |
| 112 | (concat name (string-replace "/" "-" commit)) |
| 113 | (file-name-nondirectory |
| 114 | (make-temp-name |
| 115 | (expand-file-name name magit-read-worktree-offsite-directory))))))) |
| 116 | |
| 117 | (defun magit--read-worktree-directory (rev) |
| 118 | (let ((default-directory (magit-toplevel)) |
| 119 | (prompt (format "Checkout %s in new worktree: " rev))) |
| 120 | (if magit-worktree-read-directory-name-function |
| 121 | (funcall magit-worktree-read-directory-name-function prompt) |
| 122 | (funcall magit-read-worktree-directory-function |
| 123 | prompt rev)))) |
| 124 | |
| 125 | ;;; Commands |
| 126 | |
| 127 | ;;;###autoload(autoload 'magit-worktree "magit-worktree" nil t) |
| 128 | (transient-define-prefix magit-worktree () |
| 129 | "Act on a worktree." |
| 130 | :man-page "git-worktree" |
| 131 | [["Create new" |
| 132 | ("b" "worktree" magit-worktree-checkout) |
| 133 | ("c" "branch and worktree" magit-worktree-branch)] |
| 134 | ["Commands" |
| 135 | ("m" "Move worktree" magit-worktree-move) |
| 136 | ("k" "Delete worktree" magit-worktree-delete) |
| 137 | ("g" "Visit worktree" magit-worktree-status)]]) |
| 138 | |
| 139 | ;;;###autoload |
| 140 | (defun magit-worktree-checkout (directory commit) |
| 141 | "Checkout COMMIT in a new worktree in DIRECTORY. |
| 142 | COMMIT may, but does not have to be, a local branch. |
| 143 | Interactively, use `magit-read-worktree-directory-function'." |
| 144 | (interactive |
| 145 | (let ((commit (magit-read-branch-or-commit |
| 146 | "In new worktree; checkout" nil |
| 147 | (mapcar #'caddr (magit-list-worktrees))))) |
| 148 | (list (magit--read-worktree-directory commit) |
| 149 | commit))) |
| 150 | (when (zerop (magit-run-git "worktree" "add" |
| 151 | (magit--expand-worktree directory) commit)) |
| 152 | (magit-diff-visit-directory directory))) |
| 153 | |
| 154 | ;;;###autoload |
| 155 | (defun magit-worktree-branch (directory branch start-point) |
| 156 | "Create a new BRANCH and check it out in a new worktree at DIRECTORY. |
| 157 | Interactively, use `magit-read-worktree-directory-function'." |
| 158 | (interactive |
| 159 | (pcase-let |
| 160 | ((`(,branch ,start-point) |
| 161 | (magit-branch-read-args "In new worktree; checkout new branch"))) |
| 162 | (list (magit--read-worktree-directory branch) |
| 163 | branch start-point))) |
| 164 | (when (zerop (magit-run-git "worktree" "add" "-b" branch |
| 165 | (magit--expand-worktree directory) start-point)) |
| 166 | (magit-diff-visit-directory directory))) |
| 167 | |
| 168 | ;;;###autoload |
| 169 | (defun magit-worktree-move (worktree directory) |
| 170 | "Move existing WORKTREE directory to DIRECTORY." |
| 171 | (interactive |
| 172 | (list (magit-completing-read "Move worktree" |
| 173 | (cdr (magit-list-worktrees)) |
| 174 | nil t nil nil |
| 175 | (magit-section-value-if 'worktree)) |
| 176 | (read-directory-name "Move worktree to: "))) |
| 177 | (if (file-directory-p (expand-file-name ".git" worktree)) |
| 178 | (user-error "You may not move the main working tree") |
| 179 | (let ((preexisting-directory (file-directory-p directory))) |
| 180 | (when (and (zerop (magit-call-git "worktree" "move" worktree |
| 181 | (magit--expand-worktree directory))) |
| 182 | (not (file-exists-p default-directory)) |
| 183 | (derived-mode-p 'magit-status-mode)) |
| 184 | (kill-buffer) |
| 185 | (magit-diff-visit-directory |
| 186 | (if preexisting-directory |
| 187 | (file-name-concat directory (file-name-nondirectory worktree)) |
| 188 | directory))) |
| 189 | (magit-refresh)))) |
| 190 | |
| 191 | (defun magit-worktree-delete (worktree) |
| 192 | "Delete a worktree, defaulting to the worktree at point. |
| 193 | The primary worktree cannot be deleted." |
| 194 | (interactive |
| 195 | (list (magit-completing-read "Delete worktree" |
| 196 | (mapcar #'car (cdr (magit-list-worktrees))) |
| 197 | nil t nil nil |
| 198 | (magit-section-value-if 'worktree)))) |
| 199 | (if (file-directory-p (expand-file-name ".git" worktree)) |
| 200 | (user-error "Deleting %s would delete the shared .git directory" worktree) |
| 201 | (let* ((wtrees (magit-list-worktrees)) |
| 202 | (wtree (assoc worktree wtrees)) |
| 203 | (locked (nth 5 wtree)) |
| 204 | (primary (file-name-as-directory (caar wtrees)))) |
| 205 | (when locked |
| 206 | (user-error "Cannot delete locked %s%s" worktree |
| 207 | (if (stringp locked) (format " [reason: %s]" locked) ""))) |
| 208 | (when (file-exists-p worktree) |
| 209 | (let (uncommitted) |
| 210 | (magit-confirm |
| 211 | (cond ((let ((default-directory worktree)) |
| 212 | (or (magit-anything-modified-p) |
| 213 | (magit-untracked-files))) |
| 214 | (setq uncommitted 'danger)) |
| 215 | (magit-delete-by-moving-to-trash 'trash) |
| 216 | ('delete)) |
| 217 | (format "%s worktree \"%s\"%s" |
| 218 | (if magit-delete-by-moving-to-trash "Trash" "Delete") |
| 219 | (file-name-nondirectory (directory-file-name worktree)) |
| 220 | (if uncommitted " despite uncommitted changes" "")) |
| 221 | nil nil (list worktree))) |
| 222 | (if magit-delete-by-moving-to-trash |
| 223 | (let ((delete-by-moving-to-trash t)) |
| 224 | (delete-directory worktree t t)) |
| 225 | (magit-call-git "worktree" "remove" "--force" worktree))) |
| 226 | (if (file-exists-p default-directory) |
| 227 | (magit-run-git "worktree" "prune") |
| 228 | (let ((default-directory primary)) |
| 229 | (magit-run-git "worktree" "prune")) |
| 230 | (when (derived-mode-p 'magit-status-mode) |
| 231 | (kill-buffer) |
| 232 | (magit-status-setup-buffer primary)))))) |
| 233 | |
| 234 | (defun magit-worktree-status (worktree) |
| 235 | "Show the status for the worktree at point. |
| 236 | If there is no worktree at point, then read one in the |
| 237 | minibuffer. If the worktree at point is the one whose |
| 238 | status is already being displayed in the current buffer, |
| 239 | then show it in Dired instead." |
| 240 | (interactive |
| 241 | (list (or (magit-section-value-if 'worktree) |
| 242 | (magit-completing-read |
| 243 | "Show status for worktree" |
| 244 | (cl-delete (directory-file-name (magit-toplevel)) |
| 245 | (magit-list-worktrees) |
| 246 | :test #'equal :key #'car) |
| 247 | nil t)))) |
| 248 | (magit-diff-visit-directory worktree)) |
| 249 | |
| 250 | (defun magit--expand-worktree (directory) |
| 251 | (magit-convert-filename-for-git (expand-file-name directory))) |
| 252 | |
| 253 | ;;; Sections |
| 254 | |
| 255 | (defvar-keymap magit-worktree-section-map |
| 256 | :doc "Keymap for `worktree' sections." |
| 257 | "<remap> <magit-delete-thing>" #'magit-worktree-delete |
| 258 | "<remap> <magit-visit-thing>" #'magit-worktree-status |
| 259 | "<4>" (magit-menu-item "Worktree commands..." #'magit-worktree) |
| 260 | "<3>" '(menu-item "--") |
| 261 | "<2>" (magit-menu-item "Delete %m" #'magit-worktree-delete) |
| 262 | "<1>" (magit-menu-item "Visit %s" #'magit-worktree-status)) |
| 263 | |
| 264 | (defun magit-insert-worktrees () |
| 265 | "Insert sections for all worktrees. |
| 266 | If there is only one worktree, then insert nothing." |
| 267 | (let ((worktrees (magit-list-worktrees))) |
| 268 | (when (length> worktrees 1) |
| 269 | (magit-insert-section (worktrees) |
| 270 | (magit-insert-heading t "Worktrees") |
| 271 | (let* ((cols |
| 272 | (mapcar |
| 273 | (lambda (config) |
| 274 | (pcase-let ((`(,directory ,commit ,branch ,bare) config)) |
| 275 | (cons (cond |
| 276 | (branch |
| 277 | (propertize |
| 278 | branch 'font-lock-face |
| 279 | (if (equal branch (magit-get-current-branch)) |
| 280 | 'magit-branch-current |
| 281 | 'magit-branch-local))) |
| 282 | (commit |
| 283 | (propertize |
| 284 | (magit-rev-abbrev commit) 'font-lock-face |
| 285 | (if (file-equal-p default-directory directory) |
| 286 | '(magit-hash magit-branch-current) |
| 287 | 'magit-hash))) |
| 288 | (bare "(bare)")) |
| 289 | config))) |
| 290 | worktrees)) |
| 291 | (align (1+ (apply #'max (mapcar (##string-width (car %)) cols))))) |
| 292 | (pcase-dolist (`(,head . ,config) cols) |
| 293 | (magit--insert-worktree |
| 294 | config |
| 295 | (concat head (make-string (- align (length head)) ?\s))))) |
| 296 | (insert ?\n))))) |
| 297 | |
| 298 | (defun magit--insert-worktree (config head) |
| 299 | "Insert worktree section for CONFIG. |
| 300 | See `magit-list-worktrees' for the format of CONFIG. HEAD is |
| 301 | a prettified reference or revision representing the worktree, |
| 302 | with padding for alignment." |
| 303 | ;; #4926 Before changing the signature, inform @vermiculus. |
| 304 | (let ((path (car config))) |
| 305 | (magit-insert-section (worktree path) |
| 306 | (insert head) |
| 307 | (insert (let ((relative (file-relative-name path)) |
| 308 | (absolute (abbreviate-file-name path))) |
| 309 | (if (or (> (string-width relative) (string-width absolute)) |
| 310 | (equal relative "./")) |
| 311 | absolute |
| 312 | relative))) |
| 313 | (insert ?\n)))) |
| 314 | |
| 315 | ;;; _ |
| 316 | (provide 'magit-worktree) |
| 317 | ;; Local Variables: |
| 318 | ;; read-symbol-shorthands: ( |
| 319 | ;; ("and$" . "cond-let--and$") |
| 320 | ;; ("thread$" . "cond-let--thread$") |
| 321 | ;; ("when$" . "cond-let--when$") |
| 322 | ;; ("and-let*" . "cond-let--and-let*") |
| 323 | ;; ("and-let" . "cond-let--and-let") |
| 324 | ;; ("if-let*" . "cond-let--if-let*") |
| 325 | ;; ("if-let" . "cond-let--if-let") |
| 326 | ;; ("when-let*" . "cond-let--when-let*") |
| 327 | ;; ("when-let" . "cond-let--when-let") |
| 328 | ;; ("while-let*" . "cond-let--while-let*") |
| 329 | ;; ("while-let" . "cond-let--while-let") |
| 330 | ;; ("match-string" . "match-string") |
| 331 | ;; ("match-str" . "match-string-no-properties")) |
| 332 | ;; End: |
| 333 | ;;; magit-worktree.el ends here |