aboutsummaryrefslogtreecommitdiffstats
path: root/elpa/magit-20220503.1245/magit-clone.el
blob: 302dcdd4c219f99aa92bcc10085c8b134780f26d (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
;;; magit-clone.el --- Clone a repository  -*- lexical-binding:t -*-

;; Copyright (C) 2008-2022 The Magit Project Contributors

;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>

;; SPDX-License-Identifier: GPL-3.0-or-later

;; Magit 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.
;;
;; Magit 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 Magit.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; This library implements clone commands.

;;; Code:

(require 'magit)

;;; Options

(defcustom magit-clone-set-remote-head nil
  "Whether cloning creates the symbolic-ref `<remote>/HEAD'."
  :package-version '(magit . "2.4.2")
  :group 'magit-commands
  :type 'boolean)

(defcustom magit-clone-set-remote.pushDefault 'ask
  "Whether to set the value of `remote.pushDefault' after cloning.

If t, then set without asking.  If nil, then don't set.  If
`ask', then ask."
  :package-version '(magit . "2.4.0")
  :group 'magit-commands
  :type '(choice (const :tag "set" t)
                 (const :tag "ask" ask)
                 (const :tag "don't set" nil)))

(defcustom magit-clone-default-directory nil
  "Default directory to use when `magit-clone' reads destination.
If nil (the default), then use the value of `default-directory'.
If a directory, then use that.  If a function, then call that
with the remote url as only argument and use the returned value."
  :package-version '(magit . "2.90.0")
  :group 'magit-commands
  :type '(choice (const     :tag "value of default-directory")
                 (directory :tag "constant directory")
                 (function  :tag "function's value")))

(defcustom magit-clone-always-transient nil
  "Whether `magit-clone' always acts as a transient prefix command.
If nil, then a prefix argument has to be used to show the transient
popup instead of invoking the default suffix `magit-clone-regular'
directly."
  :package-version '(magit . "3.0.0")
  :group 'magit-commands
  :type 'boolean)

(defcustom magit-clone-name-alist
  '(("\\`\\(?:github:\\|gh:\\)?\\([^:]+\\)\\'" "github.com" "github.user")
    ("\\`\\(?:gitlab:\\|gl:\\)\\([^:]+\\)\\'"  "gitlab.com" "gitlab.user"))
  "Alist mapping repository names to repository urls.

Each element has the form (REGEXP HOSTNAME USER).  When the user
enters a name when a cloning command asks for a name or url, then
that is looked up in this list.  The first element whose REGEXP
matches is used.

The format specified by option `magit-clone-url-format' is used
to turn the name into an url, using HOSTNAME and the repository
name.  If the provided name contains a slash, then that is used.
Otherwise if the name omits the owner of the repository, then the
default user specified in the matched entry is used.

If USER contains a dot, then it is treated as a Git variable and
the value of that is used as the username.  Otherwise it is used
as the username itself."
  :package-version '(magit . "3.0.0")
  :group 'magit-commands
  :type '(repeat (list regexp
                       (string :tag "hostname")
                       (string :tag "user name or git variable"))))

(defcustom magit-clone-url-format "git@%h:%n.git"
  "Format used when turning repository names into urls.
%h is the hostname and %n is the repository name, including
the name of the owner.  Also see `magit-clone-name-alist'."
  :package-version '(magit . "3.0.0")
  :group 'magit-commands
  :type 'regexp)

;;; Commands

;;;###autoload (autoload 'magit-clone "magit-clone" nil t)
(transient-define-prefix magit-clone (&optional transient)
  "Clone a repository."
  :man-page "git-clone"
  ["Fetch arguments"
   ("-B" "Clone a single branch"  "--single-branch")
   ("-n" "Do not clone tags"      "--no-tags")
   ("-S" "Clones submodules"      "--recurse-submodules" :level 6)
   ("-l" "Do not optimize"        "--no-local" :level 7)]
  ["Setup arguments"
   ("-o" "Set name of remote"     ("-o" "--origin="))
   ("-b" "Set HEAD branch"        ("-b" "--branch="))
   (magit-clone:--filter
    :if (lambda () (magit-git-version>= "2.17.0"))
    :level 7)
   ("-g" "Separate git directory" "--separate-git-dir="
    transient-read-directory :level 7)
   ("-t" "Use template directory" "--template="
    transient-read-existing-directory :level 6)]
  ["Local sharing arguments"
   ("-s" "Share objects"          ("-s" "--shared" :level 7))
   ("-h" "Do not use hardlinks"   "--no-hardlinks")]
  ["Clone"
   ("C" "regular"            magit-clone-regular)
   ("s" "shallow"            magit-clone-shallow)
   ("d" "shallow since date" magit-clone-shallow-since :level 7)
   ("e" "shallow excluding"  magit-clone-shallow-exclude :level 7)
   (">" "sparse checkout"    magit-clone-sparse
    :if (lambda () (magit-git-version>= "2.25.0"))
    :level 6)
   ("b" "bare"               magit-clone-bare)
   ("m" "mirror"             magit-clone-mirror)]
  (interactive (list (or magit-clone-always-transient current-prefix-arg)))
  (if transient
      (transient-setup 'magit-clone)
    (call-interactively #'magit-clone-regular)))

(transient-define-argument magit-clone:--filter ()
  :description "Filter some objects"
  :class 'transient-option
  :key "-f"
  :argument "--filter="
  :reader #'magit-clone-read-filter)

(defun magit-clone-read-filter (prompt initial-input history)
  (magit-completing-read prompt
                         (list "blob:none" "tree:0")
                         nil nil initial-input history))

;;;###autoload
(defun magit-clone-regular (repository directory args)
  "Create a clone of REPOSITORY in DIRECTORY.
Then show the status buffer for the new repository."
  (interactive (magit-clone-read-args))
  (magit-clone-internal repository directory args))

;;;###autoload
(defun magit-clone-shallow (repository directory args depth)
  "Create a shallow clone of REPOSITORY in DIRECTORY.
Then show the status buffer for the new repository.
With a prefix argument read the DEPTH of the clone;
otherwise use 1."
  (interactive (append (magit-clone-read-args)
                       (list (if current-prefix-arg
                                 (read-number "Depth: " 1)
                               1))))
  (magit-clone-internal repository directory
                        (cons (format "--depth=%s" depth) args)))

;;;###autoload
(defun magit-clone-shallow-since (repository directory args date)
  "Create a shallow clone of REPOSITORY in DIRECTORY.
Then show the status buffer for the new repository.
Exclude commits before DATE, which is read from the
user."
  (interactive (append (magit-clone-read-args)
                       (list (transient-read-date "Exclude commits before: "
                                                  nil nil))))
  (magit-clone-internal repository directory
                        (cons (format "--shallow-since=%s" date) args)))

;;;###autoload
(defun magit-clone-shallow-exclude (repository directory args exclude)
  "Create a shallow clone of REPOSITORY in DIRECTORY.
Then show the status buffer for the new repository.
Exclude commits reachable from EXCLUDE, which is a
branch or tag read from the user."
  (interactive (append (magit-clone-read-args)
                       (list (read-string "Exclude commits reachable from: "))))
  (magit-clone-internal repository directory
                        (cons (format "--shallow-exclude=%s" exclude) args)))

;;;###autoload
(defun magit-clone-bare (repository directory args)
  "Create a bare clone of REPOSITORY in DIRECTORY.
Then show the status buffer for the new repository."
  (interactive (magit-clone-read-args))
  (magit-clone-internal repository directory (cons "--bare" args)))

;;;###autoload
(defun magit-clone-mirror (repository directory args)
  "Create a mirror of REPOSITORY in DIRECTORY.
Then show the status buffer for the new repository."
  (interactive (magit-clone-read-args))
  (magit-clone-internal repository directory (cons "--mirror" args)))

;;;###autoload
(defun magit-clone-sparse (repository directory args)
  "Clone REPOSITORY into DIRECTORY and create a sparse checkout."
  (interactive (magit-clone-read-args))
  (magit-clone-internal repository directory (cons "--no-checkout" args)
                        'sparse))

(defun magit-clone-internal (repository directory args &optional sparse)
  (let* ((checkout (not (memq (car args) '("--bare" "--mirror"))))
         (remote (or (transient-arg-value "--origin" args)
                     (magit-get "clone.defaultRemote")
                     "origin"))
         (set-push-default
          (and checkout
               (or (eq  magit-clone-set-remote.pushDefault t)
                   (and magit-clone-set-remote.pushDefault
                        (y-or-n-p (format "Set `remote.pushDefault' to %S? "
                                          remote)))))))
    (run-hooks 'magit-credential-hook)
    (setq directory (file-name-as-directory (expand-file-name directory)))
    (when (file-exists-p directory)
      (if (file-directory-p directory)
          (when (length> (directory-files directory) 2)
            (let ((name (magit-clone--url-to-name repository)))
              (unless (and name
                           (setq directory (file-name-as-directory
                                            (expand-file-name name directory)))
                           (not (file-exists-p directory)))
                (user-error "%s already exists" directory))))
        (user-error "%s already exists and is not a directory" directory)))
    (magit-run-git-async "clone" args "--" repository
                         (magit-convert-filename-for-git directory))
    ;; Don't refresh the buffer we're calling from.
    (process-put magit-this-process 'inhibit-refresh t)
    (set-process-sentinel
     magit-this-process
     (lambda (process event)
       (when (memq (process-status process) '(exit signal))
         (let ((magit-process-raise-error t))
           (magit-process-sentinel process event)))
       (when (and (eq (process-status process) 'exit)
                  (= (process-exit-status process) 0))
         (when checkout
           (let ((default-directory directory))
             (when set-push-default
               (setf (magit-get "remote.pushDefault") remote))
             (unless magit-clone-set-remote-head
               (magit-remote-unset-head remote))))
         (when (and sparse checkout)
           (when (magit-git-version< "2.25.0")
             (user-error
              "`git sparse-checkout' not available until Git v2.25"))
           (let ((default-directory directory))
             (magit-call-git "sparse-checkout" "init" "--cone")
             (magit-call-git "checkout" (magit-get-current-branch))))
         (with-current-buffer (process-get process 'command-buf)
           (magit-status-setup-buffer directory)))))))

(defun magit-clone-read-args ()
  (let ((repo (magit-clone-read-repository)))
    (list repo
          (read-directory-name
           "Clone to: "
           (if (functionp magit-clone-default-directory)
               (funcall magit-clone-default-directory repo)
             magit-clone-default-directory)
           nil nil
           (magit-clone--url-to-name repo))
          (transient-args 'magit-clone))))

(defun magit-clone-read-repository ()
  (magit-read-char-case "Clone from " nil
    (?u "[u]rl or name"
        (let ((str (magit-read-string-ns "Clone from url or name")))
          (if (string-match-p "\\(://\\|@\\)" str)
              str
            (magit-clone--name-to-url str))))
    (?p "[p]ath"
        (magit-convert-filename-for-git
         (read-directory-name "Clone repository: ")))
    (?l "[l]ocal url"
        (concat "file://"
                (magit-convert-filename-for-git
                 (read-directory-name "Clone repository: file://"))))
    (?b "or [b]undle"
        (magit-convert-filename-for-git
         (read-file-name "Clone from bundle: ")))))

(defun magit-clone--url-to-name (url)
  (and (string-match "\\([^/:]+?\\)\\(/?\\.git\\)?$" url)
       (match-string 1 url)))

(defun magit-clone--name-to-url (name)
  (or (seq-some
       (pcase-lambda (`(,re ,host ,user))
         (and (string-match re name)
              (let ((repo (match-string 1 name)))
                (magit-clone--format-url host user repo))))
       magit-clone-name-alist)
      (user-error "Not an url and no matching entry in `%s'"
                  'magit-clone-name-alist)))

(defun magit-clone--format-url (host user repo)
  (format-spec
   magit-clone-url-format
   `((?h . ,host)
     (?n . ,(if (string-search "/" repo)
                repo
              (if (string-search "." user)
                  (if-let ((user (magit-get user)))
                      (concat user "/" repo)
                    (user-error "Set %S or specify owner explicitly" user))
                (concat user "/" repo)))))))

;;; _
(provide 'magit-clone)
;;; magit-clone.el ends here