dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

magit-clone.el (12214B)


      1 ;;; magit-clone.el --- clone a repository  -*- lexical-binding: t -*-
      2 
      3 ;; Copyright (C) 2008-2021  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 ;; SPDX-License-Identifier: GPL-3.0-or-later
     12 
     13 ;; Magit is free software; you can redistribute it and/or modify it
     14 ;; under the terms of the GNU General Public License as published by
     15 ;; the Free Software Foundation; either version 3, or (at your option)
     16 ;; any later version.
     17 ;;
     18 ;; Magit is distributed in the hope that it will be useful, but WITHOUT
     19 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
     20 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
     21 ;; License for more details.
     22 ;;
     23 ;; You should have received a copy of the GNU General Public License
     24 ;; along with Magit.  If not, see http://www.gnu.org/licenses.
     25 
     26 ;;; Commentary:
     27 
     28 ;; This library implements clone commands.
     29 
     30 ;;; Code:
     31 
     32 (require 'magit)
     33 
     34 ;;; Options
     35 
     36 (defcustom magit-clone-set-remote-head nil
     37   "Whether cloning creates the symbolic-ref `<remote>/HEAD'."
     38   :package-version '(magit . "2.4.2")
     39   :group 'magit-commands
     40   :type 'boolean)
     41 
     42 (defcustom magit-clone-set-remote.pushDefault 'ask
     43   "Whether to set the value of `remote.pushDefault' after cloning.
     44 
     45 If t, then set without asking.  If nil, then don't set.  If
     46 `ask', then ask."
     47   :package-version '(magit . "2.4.0")
     48   :group 'magit-commands
     49   :type '(choice (const :tag "set" t)
     50                  (const :tag "ask" ask)
     51                  (const :tag "don't set" nil)))
     52 
     53 (defcustom magit-clone-default-directory nil
     54   "Default directory to use when `magit-clone' reads destination.
     55 If nil (the default), then use the value of `default-directory'.
     56 If a directory, then use that.  If a function, then call that
     57 with the remote url as only argument and use the returned value."
     58   :package-version '(magit . "2.90.0")
     59   :group 'magit-commands
     60   :type '(choice (const     :tag "value of default-directory")
     61                  (directory :tag "constant directory")
     62                  (function  :tag "function's value")))
     63 
     64 (defcustom magit-clone-always-transient nil
     65   "Whether `magit-clone' always acts as a transient prefix command.
     66 If nil, then a prefix argument has to be used to show the transient
     67 popup instead of invoking the default suffix `magit-clone-regular'
     68 directly."
     69   :package-version '(magit . "3.0.0")
     70   :group 'magit-commands
     71   :type 'boolean)
     72 
     73 (defcustom magit-clone-name-alist
     74   '(("\\`\\(?:github:\\|gh:\\)?\\([^:]+\\)\\'" "github.com" "github.user")
     75     ("\\`\\(?:gitlab:\\|gl:\\)\\([^:]+\\)\\'"  "gitlab.com" "gitlab.user"))
     76   "Alist mapping repository names to repository urls.
     77 
     78 Each element has the form (REGEXP HOSTNAME USER).  When the user
     79 enters a name when a cloning command asks for a name or url, then
     80 that is looked up in this list.  The first element whose REGEXP
     81 matches is used.
     82 
     83 The format specified by option `magit-clone-url-format' is used
     84 to turn the name into an url, using HOSTNAME and the repository
     85 name.  If the provided name contains a slash, then that is used.
     86 Otherwise if the name omits the owner of the repository, then the
     87 default user specified in the matched entry is used.
     88 
     89 If USER contains a dot, then it is treated as a Git variable and
     90 the value of that is used as the username.  Otherwise it is used
     91 as the username itself."
     92   :package-version '(magit . "3.0.0")
     93   :group 'magit-commands
     94   :type '(repeat (list regexp
     95                        (string :tag "hostname")
     96                        (string :tag "user name or git variable"))))
     97 
     98 (defcustom magit-clone-url-format "git@%h:%n.git"
     99   "Format used when turning repository names into urls.
    100 %h is the hostname and %n is the repository name, including
    101 the name of the owner.  Also see `magit-clone-name-alist'."
    102   :package-version '(magit . "3.0.0")
    103   :group 'magit-commands
    104   :type 'regexp)
    105 
    106 ;;; Commands
    107 
    108 ;;;###autoload (autoload 'magit-clone "magit-clone" nil t)
    109 (transient-define-prefix magit-clone (&optional transient)
    110   "Clone a repository."
    111   :man-page "git-clone"
    112   ["Fetch arguments"
    113    ("-B" "Clone a single branch"  "--single-branch")
    114    ("-n" "Do not clone tags"      "--no-tags")
    115    ("-S" "Clones submodules"      "--recurse-submodules" :level 6)
    116    ("-l" "Do not optimize"        "--no-local" :level 7)]
    117   ["Setup arguments"
    118    ("-o" "Set name of remote"     ("-o" "--origin="))
    119    ("-b" "Set HEAD branch"        ("-b" "--branch="))
    120    ("-g" "Separate git directory" "--separate-git-dir="
    121     transient-read-directory :level 7)
    122    ("-t" "Use template directory" "--template="
    123     transient-read-existing-directory :level 6)]
    124   ["Local sharing arguments"
    125    ("-s" "Share objects"          ("-s" "--shared" :level 7))
    126    ("-h" "Do not use hardlinks"   "--no-hardlinks")]
    127   ["Clone"
    128    ("C" "regular"            magit-clone-regular)
    129    ("s" "shallow"            magit-clone-shallow)
    130    ("d" "shallow since date" magit-clone-shallow-since :level 7)
    131    ("e" "shallow excluding"  magit-clone-shallow-exclude :level 7)
    132    ("b" "bare"               magit-clone-bare)
    133    ("m" "mirror"             magit-clone-mirror)]
    134   (interactive (list (or magit-clone-always-transient current-prefix-arg)))
    135   (if transient
    136       (transient-setup #'magit-clone)
    137     (call-interactively #'magit-clone-regular)))
    138 
    139 ;;;###autoload
    140 (defun magit-clone-regular (repository directory args)
    141   "Create a clone of REPOSITORY in DIRECTORY.
    142 Then show the status buffer for the new repository."
    143   (interactive (magit-clone-read-args))
    144   (magit-clone-internal repository directory args))
    145 
    146 ;;;###autoload
    147 (defun magit-clone-shallow (repository directory args depth)
    148   "Create a shallow clone of REPOSITORY in DIRECTORY.
    149 Then show the status buffer for the new repository.
    150 With a prefix argument read the DEPTH of the clone;
    151 otherwise use 1."
    152   (interactive (append (magit-clone-read-args)
    153                        (list (if current-prefix-arg
    154                                  (read-number "Depth: " 1)
    155                                1))))
    156   (magit-clone-internal repository directory
    157                         (cons (format "--depth=%s" depth) args)))
    158 
    159 ;;;###autoload
    160 (defun magit-clone-shallow-since (repository directory args date)
    161   "Create a shallow clone of REPOSITORY in DIRECTORY.
    162 Then show the status buffer for the new repository.
    163 Exclude commits before DATE, which is read from the
    164 user."
    165   (interactive (append (magit-clone-read-args)
    166                        (list (transient-read-date "Exclude commits before: "
    167                                                   nil nil))))
    168   (magit-clone-internal repository directory
    169                         (cons (format "--shallow-since=%s" date) args)))
    170 
    171 ;;;###autoload
    172 (defun magit-clone-shallow-exclude (repository directory args exclude)
    173   "Create a shallow clone of REPOSITORY in DIRECTORY.
    174 Then show the status buffer for the new repository.
    175 Exclude commits reachable from EXCLUDE, which is a
    176 branch or tag read from the user."
    177   (interactive (append (magit-clone-read-args)
    178                        (list (read-string "Exclude commits reachable from: "))))
    179   (magit-clone-internal repository directory
    180                         (cons (format "--shallow-exclude=%s" exclude) args)))
    181 
    182 ;;;###autoload
    183 (defun magit-clone-bare (repository directory args)
    184   "Create a bare clone of REPOSITORY in DIRECTORY.
    185 Then show the status buffer for the new repository."
    186   (interactive (magit-clone-read-args))
    187   (magit-clone-internal repository directory (cons "--bare" args)))
    188 
    189 ;;;###autoload
    190 (defun magit-clone-mirror (repository directory args)
    191   "Create a mirror of REPOSITORY in DIRECTORY.
    192 Then show the status buffer for the new repository."
    193   (interactive (magit-clone-read-args))
    194   (magit-clone-internal repository directory (cons "--mirror" args)))
    195 
    196 (defun magit-clone-internal (repository directory args)
    197   (let* ((checkout (not (memq (car args) '("--bare" "--mirror"))))
    198          (remote (or (transient-arg-value "--origin" args)
    199                      (magit-get "clone.defaultRemote")
    200                      "origin"))
    201          (set-push-default
    202           (and checkout
    203                (or (eq  magit-clone-set-remote.pushDefault t)
    204                    (and magit-clone-set-remote.pushDefault
    205                         (y-or-n-p (format "Set `remote.pushDefault' to %S? "
    206                                           remote)))))))
    207     (run-hooks 'magit-credential-hook)
    208     (setq directory (file-name-as-directory (expand-file-name directory)))
    209     (when (file-exists-p directory)
    210       (if (file-directory-p directory)
    211           (when (> (length (directory-files directory)) 2)
    212             (let ((name (magit-clone--url-to-name repository)))
    213               (unless (and name
    214                            (setq directory (file-name-as-directory
    215                                             (expand-file-name name directory)))
    216                            (not (file-exists-p directory)))
    217                 (user-error "%s already exists" directory))))
    218         (user-error "%s already exists and is not a directory" directory)))
    219     (magit-run-git-async "clone" args "--" repository
    220                          (magit-convert-filename-for-git directory))
    221     ;; Don't refresh the buffer we're calling from.
    222     (process-put magit-this-process 'inhibit-refresh t)
    223     (set-process-sentinel
    224      magit-this-process
    225      (lambda (process event)
    226        (when (memq (process-status process) '(exit signal))
    227          (let ((magit-process-raise-error t))
    228            (magit-process-sentinel process event)))
    229        (when (and (eq (process-status process) 'exit)
    230                   (= (process-exit-status process) 0))
    231          (when checkout
    232            (let ((default-directory directory))
    233              (when set-push-default
    234                (setf (magit-get "remote.pushDefault") remote))
    235              (unless magit-clone-set-remote-head
    236                (magit-remote-unset-head remote))))
    237          (with-current-buffer (process-get process 'command-buf)
    238            (magit-status-setup-buffer directory)))))))
    239 
    240 (defun magit-clone-read-args ()
    241   (let ((repo (magit-clone-read-repository)))
    242     (list repo
    243           (read-directory-name
    244            "Clone to: "
    245            (if (functionp magit-clone-default-directory)
    246                (funcall magit-clone-default-directory repo)
    247              magit-clone-default-directory)
    248            nil nil
    249            (magit-clone--url-to-name repo))
    250           (transient-args 'magit-clone))))
    251 
    252 (defun magit-clone-read-repository ()
    253   (magit-read-char-case "Clone from " nil
    254     (?u "[u]rl or name"
    255         (let ((str (magit-read-string-ns "Clone from url or name")))
    256           (if (string-match-p "\\(://\\|@\\)" str)
    257               str
    258             (magit-clone--name-to-url str))))
    259     (?p "[p]ath"
    260         (magit-convert-filename-for-git
    261          (read-directory-name "Clone repository: ")))
    262     (?l "[l]ocal url"
    263         (concat "file://"
    264                 (magit-convert-filename-for-git
    265                  (read-directory-name "Clone repository: file://"))))
    266     (?b "or [b]undle"
    267         (magit-convert-filename-for-git
    268          (read-file-name "Clone from bundle: ")))))
    269 
    270 (defun magit-clone--url-to-name (url)
    271   (and (string-match "\\([^/:]+?\\)\\(/?\\.git\\)?$" url)
    272        (match-string 1 url)))
    273 
    274 (defun magit-clone--name-to-url (name)
    275   (or (seq-some
    276        (pcase-lambda (`(,re ,host ,user))
    277          (and (string-match re name)
    278               (let ((repo (match-string 1 name)))
    279                 (magit-clone--format-url host user repo))))
    280        magit-clone-name-alist)
    281       (user-error "Not an url and no matching entry in `%s'"
    282                   'magit-clone-name-alist)))
    283 
    284 (defun magit-clone--format-url (host user repo)
    285   (format-spec
    286    magit-clone-url-format
    287    `((?h . ,host)
    288      (?n . ,(if (string-match-p "/" repo)
    289                 repo
    290               (if (string-match-p "\\." user)
    291                   (if-let ((user (magit-get user)))
    292                       (concat user "/" repo)
    293                     (user-error "Set %S or specify owner explicitly" user))
    294                 (concat user "/" repo)))))))
    295 
    296 ;;; _
    297 (provide 'magit-clone)
    298 ;;; magit-clone.el ends here