config

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

magit-clone.el (14743B)


      1 ;;; magit-clone.el --- Clone a repository  -*- 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 clone commands.
     26 
     27 ;;; Code:
     28 
     29 (require 'magit)
     30 
     31 ;;; Options
     32 
     33 (defcustom magit-clone-set-remote-head nil
     34   "Whether cloning creates the symbolic-ref `<remote>/HEAD'."
     35   :package-version '(magit . "2.4.2")
     36   :group 'magit-commands
     37   :type 'boolean)
     38 
     39 (defcustom magit-clone-set-remote.pushDefault 'ask
     40   "Whether to set the value of `remote.pushDefault' after cloning.
     41 
     42 If t, then set without asking.  If nil, then don't set.  If
     43 `ask', then ask."
     44   :package-version '(magit . "2.4.0")
     45   :group 'magit-commands
     46   :type '(choice (const :tag "set" t)
     47                  (const :tag "ask" ask)
     48                  (const :tag "don't set" nil)))
     49 
     50 (defcustom magit-clone-default-directory nil
     51   "Default directory to use when `magit-clone' reads destination.
     52 If nil (the default), then use the value of `default-directory'.
     53 If a directory, then use that.  If a function, then call that
     54 with the remote url as only argument and use the returned value."
     55   :package-version '(magit . "2.90.0")
     56   :group 'magit-commands
     57   :type '(choice (const     :tag "value of default-directory")
     58                  (directory :tag "constant directory")
     59                  (function  :tag "function's value")))
     60 
     61 (defcustom magit-clone-always-transient nil
     62   "Whether `magit-clone' always acts as a transient prefix command.
     63 If nil, then a prefix argument has to be used to show the transient
     64 popup instead of invoking the default suffix `magit-clone-regular'
     65 directly."
     66   :package-version '(magit . "3.0.0")
     67   :group 'magit-commands
     68   :type 'boolean)
     69 
     70 (defcustom magit-clone-name-alist
     71   '(("\\`\\(?:github:\\|gh:\\)?\\([^:]+\\)\\'" "github.com" "github.user")
     72     ("\\`\\(?:gitlab:\\|gl:\\)\\([^:]+\\)\\'"  "gitlab.com" "gitlab.user")
     73     ("\\`\\(?:sourcehut:\\|sh:\\)\\([^:]+\\)\\'" "git.sr.ht" "sourcehut.user"))
     74   "Alist mapping repository names to repository urls.
     75 
     76 Each element has the form (REGEXP HOSTNAME USER).  When the user
     77 enters a name when a cloning command asks for a name or url, then
     78 that is looked up in this list.  The first element whose REGEXP
     79 matches is used.
     80 
     81 The format specified by option `magit-clone-url-format' is used
     82 to turn the name into an url, using HOSTNAME and the repository
     83 name.  If the provided name contains a slash, then that is used.
     84 Otherwise if the name omits the owner of the repository, then the
     85 default user specified in the matched entry is used.
     86 
     87 If USER contains a dot, then it is treated as a Git variable and
     88 the value of that is used as the username.  Otherwise it is used
     89 as the username itself."
     90   :package-version '(magit . "4.0.0")
     91   :group 'magit-commands
     92   :type '(repeat (list regexp
     93                        (string :tag "Hostname")
     94                        (string :tag "User name or git variable"))))
     95 
     96 (defcustom magit-clone-url-format
     97   '(("git.sr.ht" . "git@%h:%n")
     98     (t . "git@%h:%n.git"))
     99   "Format(s) used when turning repository names into urls.
    100 
    101 In a format string, %h is the hostname and %n is the repository
    102 name, including the name of the owner.
    103 
    104 The value can be a string (representing a single static format)
    105 or an alist with elements (HOSTNAME . FORMAT) mapping hostnames
    106 to formats.  When an alist is used, the t key represents the
    107 default.  Also see `magit-clone-name-alist'."
    108   :package-version '(magit . "4.0.0")
    109   :group 'magit-commands
    110   :type '(choice (string :tag "Format")
    111                  (alist :key-type (choice (string :tag "Host")
    112                                           (const :tag "Default" t))
    113                         :value-type (string :tag "Format"))))
    114 
    115 (defcustom magit-post-clone-hook nil
    116   "Hook run after the repository has been successfully cloned.
    117 
    118 When the hook is called, `default-directory' is let-bound to the
    119 directory where the repository has been cloned."
    120   :package-version '(magit . "4.0.0")
    121   :group 'magit-commands
    122   :type 'hook)
    123 
    124 ;;; Commands
    125 
    126 ;;;###autoload (autoload 'magit-clone "magit-clone" nil t)
    127 (transient-define-prefix magit-clone (&optional transient)
    128   "Clone a repository."
    129   :man-page "git-clone"
    130   ["Fetch arguments"
    131    ("-B" "Clone a single branch"  "--single-branch")
    132    ("-n" "Do not clone tags"      "--no-tags")
    133    ("-S" "Clones submodules"      "--recurse-submodules" :level 6)
    134    ("-l" "Do not optimize"        "--no-local" :level 7)]
    135   ["Setup arguments"
    136    ("-o" "Set name of remote"     ("-o" "--origin="))
    137    ("-b" "Set HEAD branch"        ("-b" "--branch="))
    138    (magit-clone:--filter
    139     :if (lambda () (magit-git-version>= "2.17.0"))
    140     :level 7)
    141    ("-g" "Separate git directory" "--separate-git-dir="
    142     transient-read-directory :level 7)
    143    ("-t" "Use template directory" "--template="
    144     transient-read-existing-directory :level 6)]
    145   ["Local sharing arguments"
    146    ("-s" "Share objects"          ("-s" "--shared" :level 7))
    147    ("-h" "Do not use hardlinks"   "--no-hardlinks")]
    148   ["Clone"
    149    ("C" "regular"            magit-clone-regular)
    150    ("s" "shallow"            magit-clone-shallow)
    151    ("d" "shallow since date" magit-clone-shallow-since :level 7)
    152    ("e" "shallow excluding"  magit-clone-shallow-exclude :level 7)
    153    (">" "sparse checkout"    magit-clone-sparse
    154     :if (lambda () (magit-git-version>= "2.25.0"))
    155     :level 6)
    156    ("b" "bare"               magit-clone-bare)
    157    ("m" "mirror"             magit-clone-mirror)]
    158   (interactive (list (or magit-clone-always-transient current-prefix-arg)))
    159   (if transient
    160       (transient-setup 'magit-clone)
    161     (call-interactively #'magit-clone-regular)))
    162 
    163 (transient-define-argument magit-clone:--filter ()
    164   :description "Filter some objects"
    165   :class 'transient-option
    166   :key "-f"
    167   :argument "--filter="
    168   :reader #'magit-clone-read-filter)
    169 
    170 (defun magit-clone-read-filter (prompt initial-input history)
    171   (magit-completing-read prompt
    172                          (list "blob:none" "tree:0")
    173                          nil nil initial-input history))
    174 
    175 ;;;###autoload
    176 (defun magit-clone-regular (repository directory args)
    177   "Create a clone of REPOSITORY in DIRECTORY.
    178 Then show the status buffer for the new repository."
    179   (interactive (magit-clone-read-args))
    180   (magit-clone-internal repository directory args))
    181 
    182 ;;;###autoload
    183 (defun magit-clone-shallow (repository directory args depth)
    184   "Create a shallow clone of REPOSITORY in DIRECTORY.
    185 Then show the status buffer for the new repository.
    186 With a prefix argument read the DEPTH of the clone;
    187 otherwise use 1."
    188   (interactive (append (magit-clone-read-args)
    189                        (list (if current-prefix-arg
    190                                  (read-number "Depth: " 1)
    191                                1))))
    192   (magit-clone-internal repository directory
    193                         (cons (format "--depth=%s" depth) args)))
    194 
    195 ;;;###autoload
    196 (defun magit-clone-shallow-since (repository directory args date)
    197   "Create a shallow clone of REPOSITORY in DIRECTORY.
    198 Then show the status buffer for the new repository.
    199 Exclude commits before DATE, which is read from the
    200 user."
    201   (interactive (append (magit-clone-read-args)
    202                        (list (transient-read-date "Exclude commits before: "
    203                                                   nil nil))))
    204   (magit-clone-internal repository directory
    205                         (cons (format "--shallow-since=%s" date) args)))
    206 
    207 ;;;###autoload
    208 (defun magit-clone-shallow-exclude (repository directory args exclude)
    209   "Create a shallow clone of REPOSITORY in DIRECTORY.
    210 Then show the status buffer for the new repository.
    211 Exclude commits reachable from EXCLUDE, which is a
    212 branch or tag read from the user."
    213   (interactive (append (magit-clone-read-args)
    214                        (list (read-string "Exclude commits reachable from: "))))
    215   (magit-clone-internal repository directory
    216                         (cons (format "--shallow-exclude=%s" exclude) args)))
    217 
    218 ;;;###autoload
    219 (defun magit-clone-bare (repository directory args)
    220   "Create a bare clone of REPOSITORY in DIRECTORY.
    221 Then show the status buffer for the new repository."
    222   (interactive (magit-clone-read-args))
    223   (magit-clone-internal repository directory (cons "--bare" args)))
    224 
    225 ;;;###autoload
    226 (defun magit-clone-mirror (repository directory args)
    227   "Create a mirror of REPOSITORY in DIRECTORY.
    228 Then show the status buffer for the new repository."
    229   (interactive (magit-clone-read-args))
    230   (magit-clone-internal repository directory (cons "--mirror" args)))
    231 
    232 ;;;###autoload
    233 (defun magit-clone-sparse (repository directory args)
    234   "Clone REPOSITORY into DIRECTORY and create a sparse checkout."
    235   (interactive (magit-clone-read-args))
    236   (magit-clone-internal repository directory (cons "--no-checkout" args)
    237                         'sparse))
    238 
    239 (defun magit-clone-internal (repository directory args &optional sparse)
    240   (let* ((checkout (not (member (car args) '("--bare" "--mirror"))))
    241          (remote (or (transient-arg-value "--origin=" args)
    242                      (magit-get "clone.defaultRemote")
    243                      "origin"))
    244          (set-push-default
    245           (and checkout
    246                (or (eq  magit-clone-set-remote.pushDefault t)
    247                    (and magit-clone-set-remote.pushDefault
    248                         (y-or-n-p (format "Set `remote.pushDefault' to %S? "
    249                                           remote)))))))
    250     (run-hooks 'magit-credential-hook)
    251     (setq directory (file-name-as-directory (expand-file-name directory)))
    252     (when (file-exists-p directory)
    253       (if (file-directory-p directory)
    254           (when (length> (directory-files directory) 2)
    255             (let ((name (magit-clone--url-to-name repository)))
    256               (unless (and name
    257                            (setq directory (file-name-as-directory
    258                                             (expand-file-name name directory)))
    259                            (not (file-exists-p directory)))
    260                 (user-error "%s already exists" directory))))
    261         (user-error "%s already exists and is not a directory" directory)))
    262     (magit-run-git-async "clone" args "--" repository
    263                          (magit-convert-filename-for-git directory))
    264     ;; Don't refresh the buffer we're calling from.
    265     (process-put magit-this-process 'inhibit-refresh t)
    266     (set-process-sentinel
    267      magit-this-process
    268      (lambda (process event)
    269        (when (memq (process-status process) '(exit signal))
    270          (let ((magit-process-raise-error t))
    271            (magit-process-sentinel process event)))
    272        (when (and (eq (process-status process) 'exit)
    273                   (= (process-exit-status process) 0))
    274          (when checkout
    275            (let ((default-directory directory))
    276              (when set-push-default
    277                (setf (magit-get "remote.pushDefault") remote))
    278              (unless magit-clone-set-remote-head
    279                (magit-remote-unset-head remote))))
    280          (when (and sparse checkout)
    281            (when (magit-git-version< "2.25.0")
    282              (user-error
    283               "`git sparse-checkout' not available until Git v2.25"))
    284            (let ((default-directory directory))
    285              (magit-call-git "sparse-checkout" "init" "--cone")
    286              (magit-call-git "checkout" (magit-get-current-branch))))
    287          (let ((default-directory directory))
    288            (run-hooks 'magit-post-clone-hook))
    289          (with-current-buffer (process-get process 'command-buf)
    290            (magit-status-setup-buffer directory)))))))
    291 
    292 (defun magit-clone-read-args ()
    293   (let ((repo (magit-clone-read-repository)))
    294     (list repo
    295           (read-directory-name
    296            "Clone to: "
    297            (if (functionp magit-clone-default-directory)
    298                (funcall magit-clone-default-directory repo)
    299              magit-clone-default-directory)
    300            nil nil
    301            (magit-clone--url-to-name repo))
    302           (transient-args 'magit-clone))))
    303 
    304 (defun magit-clone-read-repository ()
    305   (magit-read-char-case "Clone from " nil
    306     (?u "[u]rl or name"
    307         (let ((str (magit-read-string-ns "Clone from url or name")))
    308           (if (string-match-p "\\(://\\|@\\)" str)
    309               str
    310             (magit-clone--name-to-url str))))
    311     (?p "[p]ath"
    312         (magit-convert-filename-for-git
    313          (read-directory-name "Clone repository: ")))
    314     (?l "[l]ocal url"
    315         (concat "file://"
    316                 (magit-convert-filename-for-git
    317                  (read-directory-name "Clone repository: file://"))))
    318     (?b "or [b]undle"
    319         (magit-convert-filename-for-git
    320          (read-file-name "Clone from bundle: ")))))
    321 
    322 (defun magit-clone--url-to-name (url)
    323   (and (string-match "\\([^/:]+?\\)\\(/?\\.git\\)?$" url)
    324        (match-string 1 url)))
    325 
    326 (defun magit-clone--name-to-url (name)
    327   (or (seq-some
    328        (pcase-lambda (`(,re ,host ,user))
    329          (and (string-match re name)
    330               (let ((repo (match-string 1 name)))
    331                 (magit-clone--format-url host user repo))))
    332        magit-clone-name-alist)
    333       (user-error "Not an url and no matching entry in `%s'"
    334                   'magit-clone-name-alist)))
    335 
    336 (defun magit-clone--format-url (host user repo)
    337   (if-let ((url-format
    338             (cond ((listp magit-clone-url-format)
    339                    (cdr (or (assoc host magit-clone-url-format)
    340                             (assoc t magit-clone-url-format))))
    341                   ((stringp magit-clone-url-format)
    342                    magit-clone-url-format))))
    343       (format-spec
    344        url-format
    345        `((?h . ,host)
    346          (?n . ,(if (string-search "/" repo)
    347                     repo
    348                   (if (string-search "." user)
    349                       (if-let ((user (magit-get user)))
    350                           (concat user "/" repo)
    351                         (user-error "Set %S or specify owner explicitly" user))
    352                     (concat user "/" repo))))))
    353     (user-error
    354      "Bogus `magit-clone-url-format' (bad type or missing default)")))
    355 
    356 ;;; _
    357 (provide 'magit-clone)
    358 ;;; magit-clone.el ends here