core: add support for local elpa repositories

It is now possible to add local elpa repositories to private variable
configuration-layer--elpa-archives for instance:

(defvar configuration-layer--elpa-archives
  '(("spacelpa" . "~/.emacs.d/.cache/spacelpa/"))
  "List of ELPA archives required by Spacemacs.")

New functions:
- configuration-layer//package-archive-absolute-pathp
- configuration-layer//package-archive-local-pathp

core/core-configuration-layer.el

@@ -307,6 +307,20 @@ cache folder.")
   (configuration-layer/load-or-install-protected-package 'package-build)
   (configuration-layer/load-or-install-protected-package 'quelpa))
 
+(defun configuration-layer//package-archive-absolute-pathp (archive)
+  "Return t if ARCHIVE has an absolute path defined."
+  (let ((path (cdr archive)))
+    (or (string-match-p "http" path)
+        (string-prefix-p "~" path)
+        (string-prefix-p "/" path))))
+
+(defun configuration-layer//package-archive-local-pathp (archive)
+  "Return t if ARCHIVE has a local path."
+  (let ((path (cdr archive)))
+    (or (string-prefix-p "~" path)
+        (string-prefix-p "/" path)
+        (string-prefix-p "\." path))))
+
 (defun configuration-layer//resolve-package-archives (archives)
   "Resolve HTTP handlers for each archive in ARCHIVES and return a list
 of all reachable ones.
@@ -315,11 +329,11 @@ left untouched.
 The returned list has a `package-archives' compliant format."
   (mapcar
    (lambda (x)
-     (cons (car x)
+     (let ((aname (car x))
-           (if (or (string-match-p "http" (cdr x))
+           (apath (cdr x)))
-                   (string-prefix-p "~" (cdr x))
+       (cons aname
-                   (string-prefix-p "/" (cdr x)))
+             (if (configuration-layer//package-archive-absolute-pathp x)
-               (cdr x)
+                 apath
                (concat
                 (if (and dotspacemacs-elpa-https
                          (not spacemacs-insecure)
@@ -327,11 +341,11 @@ The returned list has a `package-archives' compliant format."
                          ;; not support HTTPS
                          ;; TODO when org ELPA repo support
                          ;; HTTPS remove the check
-                       ;; `(not (equal "org" (car x)))'
+                         ;; `(not (equal "org" aname))'
-                       (not (equal "org" (car x))))
+                         (not (equal "org" aname)))
                     "https://"
                   "http://")
-              (cdr x)))))
+                apath)))))
    archives))
 
 (defun configuration-layer/retrieve-package-archives (&optional quiet force)
@@ -355,13 +369,18 @@ refreshed during the current session."
     (let ((count (length package-archives))
           (i 1))
       (dolist (archive package-archives)
+        (let ((aname (car archive))
+              (apath (cdr archive)))
           (unless quiet
             (spacemacs-buffer/replace-last-line
              (format "--> refreshing package archive: %s... [%s/%s]"
-                   (car archive) i count) t))
+                     aname i count) t))
           (spacemacs//redisplay)
           (setq i (1+ i))
-        (unless (eq 'error
+          (unless
+              (and (not (configuration-layer//package-archive-local-pathp
+                         archive))
+                   (eq 'error
                        (with-timeout
                            (dotspacemacs-elpa-timeout
                             (progn
@@ -369,18 +388,19 @@ refreshed during the current session."
                                'spacemacs
                                (format
                                 "\nError connection time out for %s repository!"
-                             (car archive)) :warning)
+                                aname) :warning)
                               'error))
                          (condition-case err
-                          (url-retrieve-synchronously (cdr archive))
+                             (url-retrieve-synchronously apath)
                            ('error
-                         (display-warning 'spacemacs
+                            (display-warning
+                             'spacemacs
                              (format
                               "\nError while contacting %s repository!"
-                           (car archive)) :warning)
+                              aname) :warning)
-                         'error))))
+                            'error)))))
             (let ((package-archives (list archive)))
-            (package-refresh-contents))))
+              (package-refresh-contents)))))
       (package-read-all-archive-contents)
       (unless quiet (spacemacs-buffer/append "\n")))))
 

tests/core/core-configuration-layer-utest.el

@@ -217,6 +217,62 @@
     (helper--set-layers `(,(cfgl-layer "layer2" :name 'layer2)) t)
     (should (eq 'layer2 (cfgl-package-get-safe-owner pkg)))))
 
+;; ---------------------------------------------------------------------------
+;; configuration-layer//package-archive-absolute-pathp
+;; ---------------------------------------------------------------------------
+
+(ert-deftest test-package-archive-absolute-pathp--http-absolute-path ()
+  (let ((input '("melpa" . "http://melpa.org/packages/")))
+    (should (configuration-layer//package-archive-absolute-pathp input))))
+
+(ert-deftest test-package-archive-absolute-pathp--https-absolute-path ()
+  (let ((input '("melpa" . "https://melpa.org/packages/")))
+    (should (configuration-layer//package-archive-absolute-pathp input))))
+
+(ert-deftest test-package-archive-absolute-pathp--user-home-tilde-absolute-path ()
+  (let ((input '("spacelpa" . "~/.elpa/spacelpa")))
+    (should (configuration-layer//package-archive-absolute-pathp input))))
+
+(ert-deftest test-package-archive-absolute-pathp--user-home-slash-absolute-path ()
+  (let ((input '("spacelpa" . "/home/rms/.elpa/spacelpa")))
+    (should (configuration-layer//package-archive-absolute-pathp input))))
+
+(ert-deftest test-package-archive-absolute-pathp--relative-path-local ()
+  (let ((input '("melpa" . "../.elpa/spacelpa")))
+    (should (not (configuration-layer//package-archive-absolute-pathp input)))))
+
+(ert-deftest test-package-archive-absolute-pathp--not-absolute-path-remote ()
+  (let ((input '("melpa" . "melpa.org/spacelpa")))
+    (should (not (configuration-layer//package-archive-absolute-pathp input)))))
+
+;; ---------------------------------------------------------------------------
+;; configuration-layer//package-archive-local-pathp
+;; ---------------------------------------------------------------------------
+
+(ert-deftest test-package-archive-local-pathp--http-not-local-path ()
+  (let ((input '("melpa" . "http://melpa.org/packages/")))
+    (should (not (configuration-layer//package-archive-local-pathp input)))))
+
+(ert-deftest test-package-archive-local-pathp--https-not-local-path ()
+  (let ((input '("melpa" . "https://melpa.org/packages/")))
+    (should (not (configuration-layer//package-archive-local-pathp input)))))
+
+(ert-deftest test-package-archive-local-pathp--user-home-tilde-local-path ()
+  (let ((input '("spacelpa" . "~/.elpa/spacelpa")))
+    (should (configuration-layer//package-archive-local-pathp input))))
+
+(ert-deftest test-package-archive-local-pathp--user-home-slash-local-path ()
+  (let ((input '("spacelpa" . "/home/rms/.elpa/spacelpa")))
+    (should (configuration-layer//package-archive-local-pathp input))))
+
+(ert-deftest test-package-archive-local-pathp--relative-local-path-local ()
+  (let ((input '("melpa" . "../.elpa/spacelpa")))
+    (should (configuration-layer//package-archive-local-pathp input))))
+
+(ert-deftest test-package-archive-local-pathp--default-not-local-path-remote ()
+  (let ((input '("melpa" . "melpa.org/spacelpa")))
+    (should (not (configuration-layer//package-archive-local-pathp input)))))
+
 ;; ---------------------------------------------------------------------------
 ;; configuration-layer//resolve-package-archives
 ;; ---------------------------------------------------------------------------