config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

magit-worktree.el (8503B)


      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 t "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