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:
syl20bnr 2017-01-18 00:24:14 -05:00
parent 273e1e94d6
commit c6bf7f7664
1 changed files with 60 additions and 12 deletions

View File

@ -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 ()