commit | author | age
|
5cb5f7
|
1 |
;;; magit-worktree.el --- worktree support -*- lexical-binding: t -*- |
C |
2 |
|
|
3 |
;; Copyright (C) 2010-2018 The Magit Project Contributors |
|
4 |
;; |
|
5 |
;; You should have received a copy of the AUTHORS.md file which |
|
6 |
;; lists all contributors. If not, see http://magit.vc/authors. |
|
7 |
|
|
8 |
;; Author: Jonas Bernoulli <jonas@bernoul.li> |
|
9 |
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> |
|
10 |
|
|
11 |
;; Magit is free software; you can redistribute it and/or modify it |
|
12 |
;; under the terms of the GNU General Public License as published by |
|
13 |
;; the Free Software Foundation; either version 3, or (at your option) |
|
14 |
;; any later version. |
|
15 |
;; |
|
16 |
;; Magit is distributed in the hope that it will be useful, but WITHOUT |
|
17 |
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY |
|
18 |
;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public |
|
19 |
;; License for more details. |
|
20 |
;; |
|
21 |
;; You should have received a copy of the GNU General Public License |
|
22 |
;; along with Magit. If not, see http://www.gnu.org/licenses. |
|
23 |
|
|
24 |
;;; Commentary: |
|
25 |
|
|
26 |
;; This library implements support for `git-worktree'. |
|
27 |
|
|
28 |
;;; Code: |
|
29 |
|
|
30 |
(require 'magit) |
|
31 |
|
|
32 |
;;; Commands |
|
33 |
|
|
34 |
;;;###autoload (autoload 'magit-worktree-popup "magit-worktree" nil t) |
|
35 |
(magit-define-popup magit-worktree-popup |
|
36 |
"Popup console for worktree commands." |
|
37 |
:man-page "git-worktree" |
|
38 |
:actions `((?b "Create new worktree" magit-worktree-checkout) |
|
39 |
(?c "Create new branch and worktree" magit-worktree-branch) |
|
40 |
,@(and (not (require (quote forge) nil t)) |
|
41 |
'((?p "Create new worktree from pull-request" |
|
42 |
magit-worktree-checkout-pull-request))) |
|
43 |
(?k "Delete worktree" magit-worktree-delete) |
|
44 |
(?g "Show status for worktree" magit-worktree-status)) |
|
45 |
:max-action-columns 1) |
|
46 |
|
|
47 |
;;;###autoload |
|
48 |
(defun magit-worktree-checkout (path branch) |
|
49 |
"Checkout BRANCH in a new worktree at PATH." |
|
50 |
(interactive |
|
51 |
(let ((branch (magit-read-local-branch-or-commit "Checkout"))) |
|
52 |
(list (read-directory-name (format "Checkout %s in new worktree: " branch)) |
|
53 |
branch))) |
|
54 |
(magit-run-git "worktree" "add" (expand-file-name path) branch) |
|
55 |
(magit-diff-visit-directory path)) |
|
56 |
|
|
57 |
(defun magit-worktree-checkout-pull-request (path pr) |
|
58 |
"Create, configure and checkout a new worktree from a pull-request. |
|
59 |
This is like `magit-checkout-pull-request', except that it |
|
60 |
also creates a new worktree. Please see the manual for more |
|
61 |
information." |
|
62 |
(interactive |
|
63 |
(let ((pr (magit-read-pull-request "Checkout pull request"))) |
|
64 |
(let-alist pr |
|
65 |
(let ((path (let ((branch (magit--pullreq-branch pr t))) |
|
66 |
(read-directory-name |
|
67 |
(format "Checkout #%s as `%s' in new worktree: " |
|
68 |
.number branch) |
|
69 |
(file-name-directory |
|
70 |
(directory-file-name default-directory)) |
|
71 |
nil nil |
|
72 |
(if (string-match-p "\\`pr-[0-9]+\\'" branch) |
|
73 |
(number-to-string .number) |
|
74 |
(format "%s-%s" .number .head.ref)))))) |
|
75 |
(when (equal path "") |
|
76 |
(user-error "The empty string isn't a valid path")) |
|
77 |
(list path pr))))) |
|
78 |
(when (and (file-exists-p path) |
|
79 |
(not (and (file-directory-p path) |
|
80 |
(= (length (directory-files "/tmp/testing/")) 2)))) |
|
81 |
(user-error "%s already exists and isn't empty" path)) |
|
82 |
(magit-worktree-checkout path |
|
83 |
(let ((inhibit-magit-refresh t)) |
|
84 |
(magit-branch-pull-request pr)))) |
|
85 |
|
|
86 |
;;;###autoload |
|
87 |
(defun magit-worktree-branch (path branch start-point &optional force) |
|
88 |
"Create a new BRANCH and check it out in a new worktree at PATH." |
|
89 |
(interactive |
|
90 |
`(,(read-directory-name "Create worktree: ") |
|
91 |
,@(butlast (magit-branch-read-args "Create and checkout branch")) |
|
92 |
,current-prefix-arg)) |
|
93 |
(magit-run-git "worktree" "add" (if force "-B" "-b") |
|
94 |
branch (expand-file-name path) start-point) |
|
95 |
(magit-diff-visit-directory path)) |
|
96 |
|
|
97 |
(defun magit-worktree-delete (worktree) |
|
98 |
"Delete a worktree, defaulting to the worktree at point. |
|
99 |
The primary worktree cannot be deleted." |
|
100 |
(interactive |
|
101 |
(list (magit-completing-read "Delete worktree" |
|
102 |
(cdr (magit-list-worktrees)) |
|
103 |
nil t nil nil |
|
104 |
(magit-section-value-if 'worktree)))) |
|
105 |
(if (file-directory-p (expand-file-name ".git" worktree)) |
|
106 |
(user-error "Deleting %s would delete the shared .git directory" worktree) |
|
107 |
(let ((primary (file-name-as-directory (caar (magit-list-worktrees))))) |
|
108 |
(magit-confirm-files (if magit-delete-by-moving-to-trash 'trash 'delete) |
|
109 |
(list "worktree")) |
|
110 |
(when (file-exists-p worktree) |
|
111 |
(let ((delete-by-moving-to-trash magit-delete-by-moving-to-trash)) |
|
112 |
(delete-directory worktree t magit-delete-by-moving-to-trash))) |
|
113 |
(if (file-exists-p default-directory) |
|
114 |
(magit-run-git "worktree" "prune") |
|
115 |
(let ((default-directory primary)) |
|
116 |
(magit-run-git "worktree" "prune")) |
|
117 |
(when (derived-mode-p 'magit-status-mode) |
|
118 |
(kill-buffer) |
|
119 |
(magit-status-internal primary)))))) |
|
120 |
|
|
121 |
(defun magit-worktree-status (worktree) |
|
122 |
"Show the status for the worktree at point. |
|
123 |
If there is no worktree at point, then read one in the |
|
124 |
minibuffer. If the worktree at point is the one whose |
|
125 |
status is already being displayed in the current buffer, |
|
126 |
then show it in Dired instead." |
|
127 |
(interactive |
|
128 |
(list (or (magit-section-value-if 'worktree) |
|
129 |
(magit-completing-read |
|
130 |
"Show status for worktree" |
|
131 |
(cl-delete (directory-file-name (magit-toplevel)) |
|
132 |
(magit-list-worktrees) |
|
133 |
:test #'equal :key #'car))))) |
|
134 |
(magit-diff-visit-directory worktree)) |
|
135 |
|
|
136 |
;;; Sections |
|
137 |
|
|
138 |
(defvar magit-worktree-section-map |
|
139 |
(let ((map (make-sparse-keymap))) |
|
140 |
(define-key map [remap magit-visit-thing] 'magit-worktree-status) |
|
141 |
(define-key map [remap magit-delete-thing] 'magit-worktree-delete) |
|
142 |
map) |
|
143 |
"Keymap for `worktree' sections.") |
|
144 |
|
|
145 |
(defun magit-insert-worktrees () |
|
146 |
"Insert sections for all worktrees. |
|
147 |
If there is only one worktree, then insert nothing." |
|
148 |
(let ((worktrees (magit-list-worktrees))) |
|
149 |
(when (> (length worktrees) 1) |
|
150 |
(magit-insert-section (worktrees) |
|
151 |
(magit-insert-heading "Worktrees:") |
|
152 |
(let* ((cols |
|
153 |
(mapcar (pcase-lambda (`(,path ,barep ,commit ,branch)) |
|
154 |
(cons (cond |
|
155 |
(branch (propertize branch |
|
156 |
'face 'magit-branch-local)) |
|
157 |
(commit (propertize (magit-rev-abbrev commit) |
|
158 |
'face 'magit-hash)) |
|
159 |
(barep "(bare)")) |
|
160 |
path)) |
|
161 |
worktrees)) |
|
162 |
(align (1+ (-max (--map (string-width (car it)) cols))))) |
|
163 |
(pcase-dolist (`(,head . ,path) cols) |
|
164 |
(magit-insert-section (worktree path) |
|
165 |
(insert head) |
|
166 |
(indent-to align) |
|
167 |
(insert (let ((r (file-relative-name path)) |
|
168 |
(a (abbreviate-file-name path))) |
|
169 |
(if (< (string-width r) (string-width a)) r a))) |
|
170 |
(insert ?\n)))) |
|
171 |
(insert ?\n))))) |
|
172 |
|
|
173 |
;;; _ |
|
174 |
(provide 'magit-worktree) |
|
175 |
;;; magit-worktree.el ends here |