diff options
| author | Philip Kaludercic | 2022-10-23 18:41:36 +0200 |
|---|---|---|
| committer | Philip Kaludercic | 2022-10-23 18:41:36 +0200 |
| commit | e31c84f4e7bca94e25845c28d2fb762a1d0ec316 (patch) | |
| tree | 6be5b58fb5c6699f828325f36fc2d689e4e80dc1 | |
| parent | a3cd8d43aefb1ad53efb076f3f6cb45d7b914d5a (diff) | |
| download | emacs-e31c84f4e7bca94e25845c28d2fb762a1d0ec316.tar.gz emacs-e31c84f4e7bca94e25845c28d2fb762a1d0ec316.zip | |
Extract separate function 'package-vc-guess-backend'
* lisp/emacs-lisp/package-vc.el (package-vc-guess-backend): New
function.
(package-vc-unpack): Use it.
(package-vc-sourced-packages-list): Use it.
(package-vc-install): Use it.
| -rw-r--r-- | lisp/emacs-lisp/package-vc.el | 17 |
1 files changed, 10 insertions, 7 deletions
diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index c667219921b..0de452d1353 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el | |||
| @@ -329,6 +329,13 @@ The output is written out into PKG-FILE." | |||
| 329 | (cons (package-desc-name pkg-desc) | 329 | (cons (package-desc-name pkg-desc) |
| 330 | package-selected-packages))) | 330 | package-selected-packages))) |
| 331 | 331 | ||
| 332 | (defun package-vc-guess-backend (url) | ||
| 333 | "Guess the VC backend for URL. | ||
| 334 | This function will internally query `package-vc-heuristic-alist' | ||
| 335 | and return nil if no reasonable guess can be made." | ||
| 336 | (and url (alist-get url package-vc-heuristic-alist | ||
| 337 | nil nil #'string-match-p))) | ||
| 338 | |||
| 332 | (defun package-vc-unpack (pkg-desc pkg-spec &optional rev) | 339 | (defun package-vc-unpack (pkg-desc pkg-spec &optional rev) |
| 333 | "Install the package described by PKG-DESC. | 340 | "Install the package described by PKG-DESC. |
| 334 | PKG-SPEC is a package specification is a property list describing | 341 | PKG-SPEC is a package specification is a property list describing |
| @@ -360,8 +367,7 @@ the `:brach' attribute in PKG-SPEC." | |||
| 360 | ;; Clone the repository into `repo-dir' if necessary | 367 | ;; Clone the repository into `repo-dir' if necessary |
| 361 | (unless (file-exists-p repo-dir) | 368 | (unless (file-exists-p repo-dir) |
| 362 | (make-directory (file-name-directory repo-dir) t) | 369 | (make-directory (file-name-directory repo-dir) t) |
| 363 | (let ((backend (or (and url (alist-get url package-vc-heuristic-alist | 370 | (let ((backend (or (package-vc-guess-backend url) |
| 364 | nil nil #'string-match-p)) | ||
| 365 | package-vc-default-backend))) | 371 | package-vc-default-backend))) |
| 366 | (unless (vc-clone url backend repo-dir (or rev branch)) | 372 | (unless (vc-clone url backend repo-dir (or rev branch)) |
| 367 | (error "Failed to clone %s from %s" name url)))) | 373 | (error "Failed to clone %s from %s" name url)))) |
| @@ -382,8 +388,7 @@ the `:brach' attribute in PKG-SPEC." | |||
| 382 | ;; pointing towards a repository, and use that as a backup | 388 | ;; pointing towards a repository, and use that as a backup |
| 383 | (and-let* ((extras (package-desc-extras (cadr pkg))) | 389 | (and-let* ((extras (package-desc-extras (cadr pkg))) |
| 384 | (url (alist-get :url extras)) | 390 | (url (alist-get :url extras)) |
| 385 | (backend (alist-get url package-vc-heuristic-alist | 391 | ((package-vc-guess-backend url)))))) |
| 386 | nil nil #'string-match-p)))))) | ||
| 387 | package-archive-contents)) | 392 | package-archive-contents)) |
| 388 | 393 | ||
| 389 | (defun package-vc-update (pkg-desc) | 394 | (defun package-vc-update (pkg-desc) |
| @@ -423,9 +428,7 @@ be requested using REV." | |||
| 423 | (package--archives-initialize) | 428 | (package--archives-initialize) |
| 424 | (cond | 429 | (cond |
| 425 | ((and-let* ((stringp name-or-url) | 430 | ((and-let* ((stringp name-or-url) |
| 426 | (backend (alist-get name-or-url | 431 | (backend (package-vc-guess-backend name-or-url))) |
| 427 | package-vc-heuristic-alist | ||
| 428 | nil nil #'string-match-p))) | ||
| 429 | (package-vc-unpack | 432 | (package-vc-unpack |
| 430 | (package-desc-create | 433 | (package-desc-create |
| 431 | :name (or name (intern (file-name-base name-or-url))) | 434 | :name (or name (intern (file-name-base name-or-url))) |