core: new functions to synchronize distant ELPA packages with local repo
New functions: configuration-layer//download-elpa-file configuration-layer//sync-elpa-packages-files
This commit is contained in:
parent
273e1e94d6
commit
c6bf7f7664
1 changed files with 60 additions and 12 deletions
|
@ -2049,8 +2049,7 @@ FILE-TO-LOAD is an explicit file to load after the installation."
|
||||||
(load-file (concat pkg-elpa-dir file-to-load)))
|
(load-file (concat pkg-elpa-dir file-to-load)))
|
||||||
pkg-elpa-dir))))
|
pkg-elpa-dir))))
|
||||||
|
|
||||||
|
(defun configuration-layer//get-indexed-elpa-package-names ()
|
||||||
(defun configuration-layer//get-elpa-packages ()
|
|
||||||
"Return a list of all ELPA packages in indexed packages and dependencies."
|
"Return a list of all ELPA packages in indexed packages and dependencies."
|
||||||
(let (result)
|
(let (result)
|
||||||
(dolist (pkg-sym (configuration-layer//get-distant-packages
|
(dolist (pkg-sym (configuration-layer//get-distant-packages
|
||||||
|
@ -2076,20 +2075,69 @@ FILE-TO-LOAD is an explicit file to load after the installation."
|
||||||
,(package-desc-kind obj)
|
,(package-desc-kind obj)
|
||||||
,(package-desc-extras obj)])))
|
,(package-desc-extras obj)])))
|
||||||
|
|
||||||
(defun configuration-layer/create-spacelpa-repository (output-dir)
|
(defun configuration-layer//download-elpa-file
|
||||||
"Create an ELPA repository containing an exhaustive list of packages."
|
(pkg-name filename archive-url output-dir
|
||||||
|
&optional signaturep readmep)
|
||||||
|
"Download FILENAME from distant ELPA repository to OUTPUT-DIR.
|
||||||
|
|
||||||
|
Original code from dochang at https://github.com/dochang/elpa-clone"
|
||||||
|
(let ((source (concat archive-url filename))
|
||||||
|
(target (expand-file-name filename output-dir)))
|
||||||
|
(unless (file-exists-p target)
|
||||||
|
(let* ((readme-filename (format "%S-readme.txt" pkg-name))
|
||||||
|
(source-readme (concat archive-url readme-filename)))
|
||||||
|
(when (and readmep (url-http-file-exists-p source-readme))
|
||||||
|
(url-copy-file source-readme
|
||||||
|
(expand-file-name readme-filename output-dir)
|
||||||
|
'ok-if-already-exists)))
|
||||||
|
(when signaturep
|
||||||
|
(let* ((sig-filename (concat filename ".sig"))
|
||||||
|
(source-sig (concat archive-url sig-filename))
|
||||||
|
(target-sig (expand-file-name sig-filename output-dir)))
|
||||||
|
(url-copy-file source-sig target-sig 'ok-if-already-exists)))
|
||||||
|
(url-copy-file source target))))
|
||||||
|
|
||||||
|
(defun configuration-layer//sync-elpa-packages-files (packages output-dir)
|
||||||
|
"Synchronize PACKAGES files from remote ELPA directory to OUTPUT-DIR"
|
||||||
|
(message "Synchronizing files in ELPA repository at %s..." output-dir)
|
||||||
|
(let (filenames
|
||||||
|
(output-filenames (directory-files
|
||||||
|
output-dir nil "\\.\\(el\\|tar\\)$"))
|
||||||
|
(pkg-count (length packages))
|
||||||
|
(i 1))
|
||||||
|
(dolist (pkg-name packages)
|
||||||
|
(let* ((obj (cadr (assq pkg-name package-archive-contents)))
|
||||||
|
(filename (concat (package-desc-full-name obj)
|
||||||
|
(package-desc-suffix obj)))
|
||||||
|
(archive-url (cdr (assq (package-desc-archive obj)
|
||||||
|
package-archives))))
|
||||||
|
(push filename filenames)
|
||||||
|
(if (member filename output-filenames)
|
||||||
|
(message "[%s/%s] Skip %s..." i pkg-count filename)
|
||||||
|
(message "[%s/%s] Download %s..." i pkg-count filename)
|
||||||
|
(configuration-layer//download-elpa-file
|
||||||
|
pkg-name filename archive-url output-dir))
|
||||||
|
(setq i (1+ i))))
|
||||||
|
(dolist (ofilename output-filenames)
|
||||||
|
(unless (member ofilename filenames)
|
||||||
|
(message "Remove outdated %s..." ofilename)
|
||||||
|
(delete-file (concat output-dir ofilename))))))
|
||||||
|
|
||||||
|
(defun configuration-layer/create-elpa-repository (name output-dir)
|
||||||
|
"Create an ELPA repository containing all packages supported by Spacemacs."
|
||||||
(configuration-layer/make-all-packages 'no-discover)
|
(configuration-layer/make-all-packages 'no-discover)
|
||||||
(let* ((packages (configuration-layer//get-elpa-packages))
|
(let* ((packages (configuration-layer//get-indexed-elpa-package-names))
|
||||||
(spacelpa-archive-contents
|
(archive-contents
|
||||||
(mapcar 'configuration-layer//create-archive-contents-item
|
(mapcar 'configuration-layer//create-archive-contents-item
|
||||||
packages)))
|
packages))
|
||||||
(push 1 spacelpa-archive-contents)
|
(path (file-name-as-directory (concat output-dir name))))
|
||||||
(unless (file-exists-p output-dir)
|
(unless (file-exists-p path) (make-directory path 'create-parents))
|
||||||
(make-directory output-dir t))
|
(configuration-layer//sync-elpa-packages-files packages path)
|
||||||
|
(push 1 archive-contents)
|
||||||
(with-current-buffer (find-file-noselect
|
(with-current-buffer (find-file-noselect
|
||||||
(concat output-dir "archive-contents"))
|
(concat path "archive-contents"))
|
||||||
(erase-buffer)
|
(erase-buffer)
|
||||||
(prin1 spacelpa-archive-contents (current-buffer))
|
(prin1 archive-contents (current-buffer))
|
||||||
(save-buffer))))
|
(save-buffer))))
|
||||||
|
|
||||||
(defun configuration-layer//increment-error-count ()
|
(defun configuration-layer//increment-error-count ()
|
||||||
|
|
Reference in a new issue