magit-worktree.el (8502B)
1 ;;; magit-worktree.el --- Worktree support -*- lexical-binding:t -*- 2 3 ;; Copyright (C) 2008-2024 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-worktree-read-directory-name-function #'read-directory-name 34 "Function used to read a directory for worktree commands. 35 This is called with one argument, the prompt, and can be used 36 to, e.g., use a base directory other than `default-directory'. 37 Used by `magit-worktree-checkout' and `magit-worktree-branch'." 38 :package-version '(magit . "3.0.0") 39 :group 'magit-commands 40 :type 'function) 41 42 ;;; Commands 43 44 ;;;###autoload (autoload 'magit-worktree "magit-worktree" nil t) 45 (transient-define-prefix magit-worktree () 46 "Act on a worktree." 47 :man-page "git-worktree" 48 [["Create new" 49 ("b" "worktree" magit-worktree-checkout) 50 ("c" "branch and worktree" magit-worktree-branch)] 51 ["Commands" 52 ("m" "Move worktree" magit-worktree-move) 53 ("k" "Delete worktree" magit-worktree-delete) 54 ("g" "Visit worktree" magit-worktree-status)]]) 55 56 ;;;###autoload 57 (defun magit-worktree-checkout (path branch) 58 "Checkout BRANCH in a new worktree at PATH." 59 (interactive 60 (let ((branch (magit-read-branch-or-commit "Checkout"))) 61 (list (funcall magit-worktree-read-directory-name-function 62 (format "Checkout %s in new worktree: " branch)) 63 branch))) 64 (magit-run-git "worktree" "add" (magit--expand-worktree path) branch) 65 (magit-diff-visit-directory path)) 66 67 ;;;###autoload 68 (defun magit-worktree-branch (path branch start-point &optional force) 69 "Create a new BRANCH and check it out in a new worktree at PATH." 70 (interactive 71 `(,(funcall magit-worktree-read-directory-name-function 72 "Create worktree: ") 73 ,@(magit-branch-read-args "Create and checkout branch") 74 ,current-prefix-arg)) 75 (magit-run-git "worktree" "add" (if force "-B" "-b") 76 branch (magit--expand-worktree path) start-point) 77 (magit-diff-visit-directory path)) 78 79 ;;;###autoload 80 (defun magit-worktree-move (worktree path) 81 "Move WORKTREE to PATH." 82 (interactive 83 (list (magit-completing-read "Move worktree" 84 (cdr (magit-list-worktrees)) 85 nil t nil nil 86 (magit-section-value-if 'worktree)) 87 (funcall magit-worktree-read-directory-name-function 88 "Move worktree to: "))) 89 (if (file-directory-p (expand-file-name ".git" worktree)) 90 (user-error "You may not move the main working tree") 91 (let ((preexisting-directory (file-directory-p path))) 92 (when (and (zerop (magit-call-git "worktree" "move" worktree 93 (magit--expand-worktree path))) 94 (not (file-exists-p default-directory)) 95 (derived-mode-p 'magit-status-mode)) 96 (kill-buffer) 97 (magit-diff-visit-directory 98 (if preexisting-directory 99 (concat (file-name-as-directory path) 100 (file-name-nondirectory worktree)) 101 path))) 102 (magit-refresh)))) 103 104 (defun magit-worktree-delete (worktree) 105 "Delete a worktree, defaulting to the worktree at point. 106 The primary worktree cannot be deleted." 107 (interactive 108 (list (magit-completing-read "Delete worktree" 109 (cdr (magit-list-worktrees)) 110 nil t nil nil 111 (magit-section-value-if 'worktree)))) 112 (if (file-directory-p (expand-file-name ".git" worktree)) 113 (user-error "Deleting %s would delete the shared .git directory" worktree) 114 (let ((primary (file-name-as-directory (caar (magit-list-worktrees))))) 115 (magit-confirm-files (if magit-delete-by-moving-to-trash 'trash 'delete) 116 (list "worktree")) 117 (when (file-exists-p worktree) 118 (let ((delete-by-moving-to-trash magit-delete-by-moving-to-trash)) 119 (delete-directory worktree t magit-delete-by-moving-to-trash))) 120 (if (file-exists-p default-directory) 121 (magit-run-git "worktree" "prune") 122 (let ((default-directory primary)) 123 (magit-run-git "worktree" "prune")) 124 (when (derived-mode-p 'magit-status-mode) 125 (kill-buffer) 126 (magit-status-setup-buffer primary)))))) 127 128 (defun magit-worktree-status (worktree) 129 "Show the status for the worktree at point. 130 If there is no worktree at point, then read one in the 131 minibuffer. If the worktree at point is the one whose 132 status is already being displayed in the current buffer, 133 then show it in Dired instead." 134 (interactive 135 (list (or (magit-section-value-if 'worktree) 136 (magit-completing-read 137 "Show status for worktree" 138 (cl-delete (directory-file-name (magit-toplevel)) 139 (magit-list-worktrees) 140 :test #'equal :key #'car))))) 141 (magit-diff-visit-directory worktree)) 142 143 (defun magit--expand-worktree (path) 144 (magit-convert-filename-for-git (expand-file-name path))) 145 146 ;;; Sections 147 148 (defvar-keymap magit-worktree-section-map 149 :doc "Keymap for `worktree' sections." 150 "<remap> <magit-delete-thing>" #'magit-worktree-delete 151 "<remap> <magit-visit-thing>" #'magit-worktree-status 152 "<4>" (magit-menu-item "Worktree commands..." #'magit-worktree) 153 "<3>" '(menu-item "--") 154 "<2>" (magit-menu-item "Delete %m" #'magit-worktree-delete) 155 "<1>" (magit-menu-item "Visit %s" #'magit-worktree-status)) 156 157 (defun magit-insert-worktrees () 158 "Insert sections for all worktrees. 159 If there is only one worktree, then insert nothing." 160 (let ((worktrees (magit-list-worktrees))) 161 (when (length> worktrees 1) 162 (magit-insert-section (worktrees) 163 (magit-insert-heading "Worktrees:") 164 (let* ((cols 165 (mapcar 166 (lambda (config) 167 (pcase-let ((`(,_ ,commit ,branch ,bare) config)) 168 (cons (cond 169 (branch 170 (propertize 171 branch 'font-lock-face 172 (if (equal branch (magit-get-current-branch)) 173 'magit-branch-current 174 'magit-branch-local))) 175 (commit 176 (propertize (magit-rev-abbrev commit) 177 'font-lock-face 'magit-hash)) 178 (bare "(bare)")) 179 config))) 180 worktrees)) 181 (align (1+ (apply #'max (--map (string-width (car it)) cols))))) 182 (pcase-dolist (`(,head . ,config) cols) 183 (magit--insert-worktree 184 config 185 (concat head (make-string (- align (length head)) ?\s))))) 186 (insert ?\n))))) 187 188 (defun magit--insert-worktree (config head) 189 "Insert worktree section for CONFIG. 190 See `magit-list-worktrees' for the format of CONFIG. HEAD is 191 a prettified reference or revision representing the worktree, 192 with padding for alignment." 193 ;; #4926 Before changing the signature, inform @vermiculus. 194 (let ((path (car config))) 195 (magit-insert-section (worktree path) 196 (insert head) 197 (insert (let ((relative (file-relative-name path)) 198 (absolute (abbreviate-file-name path))) 199 (if (or (> (string-width relative) (string-width absolute)) 200 (equal relative "./")) 201 absolute 202 relative))) 203 (insert ?\n)))) 204 205 ;;; _ 206 (provide 'magit-worktree) 207 ;;; magit-worktree.el ends here