Skip to content

Commit

Permalink
core: use request.el to check elpa archive availability
Browse files Browse the repository at this point in the history
Add request.el to core/libs
Refactor package.el initialization in configuration-layer.el
Cosmetic improvements to loading messages
Remove redefinition of package-refresh-packages
  • Loading branch information
syl20bnr committed Dec 3, 2015
1 parent 7be6176 commit d822241
Show file tree
Hide file tree
Showing 7 changed files with 1,471 additions and 110 deletions.
131 changes: 88 additions & 43 deletions core/core-configuration-layer.el
Original file line number Diff line number Diff line change
Expand Up @@ -19,36 +19,13 @@
(require 'package)
(require 'warnings)
(require 'ht)
(require 'request)
(require 'core-dotspacemacs)
(require 'core-funcs)
(require 'core-spacemacs-buffer)

(unless package--initialized
(let ((archives '(("melpa" . "melpa.org/packages/")
("org" . "orgmode.org/elpa/")
("gnu" . "elpa.gnu.org/packages/"))))
(setq package-archives
(mapcar (lambda (x)
(cons (car x) (concat
(if (and dotspacemacs-elpa-https
;; for now org ELPA repository does
;; not support HTTPS
;; TODO when org ELPA repo support
;; HTTPS remove the check
;; `(not (equal "org" (car x)))'
(not (equal "org" (car x))))
"https://"
"http://") (cdr x))))
archives)))
;; optimization, no need to activate all the packages so early
(setq package-enable-at-startup nil)
(package-initialize 'noactivate)
;; Emacs 24.3 and above ships with python.el but in some Emacs 24.3.1 packages
;; for Ubuntu, python.el seems to be missing.
;; This hack adds marmalade repository for this case only.
(unless (or (package-installed-p 'python) (version< emacs-version "24.3"))
(add-to-list 'package-archives
'("marmalade" . "https://marmalade-repo.org/packages/"))))
(defconst configuration-layer--refresh-package-timeout 3
"Timeout in seconds to reach a package archive page.")

(defconst configuration-layer-template-directory
(expand-file-name (concat spacemacs-core-directory "templates/"))
Expand Down Expand Up @@ -135,6 +112,12 @@
:documentation
"If non-nil this package is excluded from all layers.")))

(defvar configuration-layer--elpa-archives
'(("melpa" . "melpa.org/packages/")
("org" . "orgmode.org/elpa/")
("gnu" . "elpa.gnu.org/packages/"))
"List of ELPA archives required by Spacemacs.")

(defvar configuration-layer--layers '()
"A non-sorted list of `cfgl-layer' objects.")

Expand Down Expand Up @@ -162,6 +145,73 @@ the path for this layer.")
"List of strings corresponding to category names. A category is a
directory with a name starting with `+'.")

(defun configuration-layer/initialize ()
"Initialize `package.el'."
(unless package--initialized
(setq package-archives (configuration-layer//resolve-package-archives
configuration-layer--elpa-archives))
;; optimization, no need to activate all the packages so early
(setq package-enable-at-startup nil)
(package-initialize 'noactivate)
;; TODO remove the following hack when 24.3 support ends
;; Emacs 24.3 and above ships with python.el but in some Emacs 24.3.1
;; packages for Ubuntu, python.el seems to be missing.
;; This hack adds marmalade repository for this case only.
(unless (or (package-installed-p 'python) (version< emacs-version "24.3"))
(add-to-list 'package-archives
'("marmalade" . "https://marmalade-repo.org/packages/")))))

(defun configuration-layer//resolve-package-archives (archives)
"Resolve HTTP handlers for each archive in ARCHIVES and return a list
of all reachable ones.
If the address of an archive already contains the protocol then this address is
left untouched.
The returned list has a `package-archives' compliant format."
(mapcar
(lambda (x)
(cons (car x)
(if (string-match-p "http" (cdr x))
(cdr x)
(concat (if (and dotspacemacs-elpa-https
;; for now org ELPA repository does
;; not support HTTPS
;; TODO when org ELPA repo support
;; HTTPS remove the check
;; `(not (equal "org" (car x)))'
(not (equal "org" (car x))))
"https://"
"http://") (cdr x)))))
archives))

(defun configuration-layer//retrieve-package-archives ()
"Retrieve all archives declared in current `package-archives'.
This function first performs a simple GET request with a timeout in order to
fix very long refresh time when an archive is not reachable.
Note that this simple GET is a heuristic to determine the availability
likelihood of an archive, so it can gives false positive if the archive
page is served but the archive is not."
(let ((count (length package-archives))
(i 1))
(dolist (archive package-archives)
(spacemacs-buffer/replace-last-line
(format "--> refreshing package archive: %s... [%s/%s]"
(car archive) i count) t)
(spacemacs//redisplay)
(setq i (1+ i))
(request (cdr archive) :sync t :type "GET"
:timeout configuration-layer--refresh-package-timeout
:error (function* (lambda (&key error-thrown &allow-other-keys)
(configuration-layer//set-error)
(spacemacs-buffer/append
(format "\n%s: %s"
(car error-thrown)
(cdr error-thrown)))))
:status-code '((200 . (lambda (&rest _)
(let ((package-archives (list archive)))
(package-refresh-contents)))))))
(package-read-all-archive-contents)
(spacemacs-buffer/append "\n")))

(defun configuration-layer/sync ()
"Synchronize declared layers in dotfile with spacemacs."
(dotspacemacs|call-func dotspacemacs/layers "Calling dotfile layers...")
Expand Down Expand Up @@ -555,7 +605,7 @@ path."
('error
(configuration-layer//set-error)
(spacemacs-buffer/append
(format (concat "An error occurred while setting layer "
(format (concat "\nAn error occurred while setting layer "
"variable %s "
"(error: %s). Be sure to quote the value "
"if needed.\n") var err))))
Expand Down Expand Up @@ -634,20 +684,18 @@ path."
(spacemacs-buffer/append
(format "Found %s new package(s) to install...\n"
noinst-count))
(spacemacs-buffer/append
"--> fetching new package repository indexes...\n")
(spacemacs//redisplay)
(package-refresh-contents)
(configuration-layer//retrieve-package-archives)
(setq installed-count 0)
(dolist (pkg-name noinst-pkg-names)
(setq installed-count (1+ installed-count))
(let* ((pkg (object-assoc pkg-name :name configuration-layer--packages))
(layer (when pkg (oref pkg :owner)))
(location (when pkg (oref pkg :location))))
(spacemacs-buffer/replace-last-line
(format "--> installing %s%s... [%s/%s]"
(if layer (format "%S:" layer) "dependency ")
pkg-name installed-count noinst-count) t)
(format "--> installing %s: %s%s... [%s/%s]"
(if layer "package" "dependency")
pkg-name (if layer (format "@%S" layer) "")
installed-count noinst-count) t)
(unless (package-installed-p pkg-name)
(condition-case err
(cond
Expand All @@ -660,7 +708,7 @@ path."
('error
(configuration-layer//set-error)
(spacemacs-buffer/append
(format (concat "An error occurred while installing %s "
(format (concat "\nAn error occurred while installing %s "
"(error: %s)\n") pkg-name err))))))
(spacemacs//redisplay))
(spacemacs-buffer/append "\n"))))
Expand Down Expand Up @@ -828,7 +876,7 @@ path."
(configuration-layer//set-error)
(spacemacs-buffer/append
(format
(concat "An error occurred while pre-configuring %S "
(concat "\nAn error occurred while pre-configuring %S "
"in layer %S (error: %s)\n")
pkg-name layer err))))))
(oref pkg :pre-layers))
Expand All @@ -848,7 +896,7 @@ path."
(configuration-layer//set-error)
(spacemacs-buffer/append
(format
(concat "An error occurred while post-configuring %S "
(concat "\nAn error occurred while post-configuring %S "
"in layer %S (error: %s)\n")
pkg-name layer err))))))
(oref pkg :post-layers))))
Expand All @@ -875,12 +923,9 @@ path."
If called with a prefix argument ALWAYS-UPDATE, assume yes to update."
(interactive "P")
(spacemacs-buffer/insert-page-break)
(spacemacs-buffer/append
"\nUpdating Emacs packages from remote repositories (ELPA, MELPA, etc.)... \n")
(spacemacs-buffer/append
"--> fetching new package repository indexes...\n")
(spacemacs//redisplay)
(package-refresh-contents)
(spacemacs-buffer/append (concat "\nUpdating Emacs packages from remote "
"repositories (ELPA, MELPA, etc.)...\n"))
(configuration-layer//retrieve-package-archives)
(setq configuration-layer--skipped-packages nil)
(let* ((update-packages
(configuration-layer//get-packages-to-update
Expand Down
60 changes: 0 additions & 60 deletions core/core-emacs-ext.el

This file was deleted.

4 changes: 0 additions & 4 deletions core/core-keybindings.el
Original file line number Diff line number Diff line change
Expand Up @@ -11,10 +11,6 @@
;;; License: GPLv3

(require 'core-funcs)
(unless (require 'which-key nil t)
(spacemacs/load-or-install-protected-package 'which-key t))
(unless (require 'bind-map nil t)
(spacemacs/load-or-install-protected-package 'bind-map t))

(defvar spacemacs/prefix-titles nil
"alist for mapping command prefixes to long names.")
Expand Down
7 changes: 4 additions & 3 deletions core/core-spacemacs.el
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,6 @@
(require 'core-toggle)
(require 'core-micro-state)
(require 'core-use-package-ext)
(require 'core-emacs-ext)

(defgroup spacemacs nil
"Spacemacs customizations."
Expand Down Expand Up @@ -81,14 +80,16 @@ initialization."
(dotspacemacs|call-func dotspacemacs/init "Calling dotfile init...")
(dotspacemacs|call-func dotspacemacs/user-init "Calling dotfile user init...")
;; spacemacs init
(require 'core-configuration-layer)
(switch-to-buffer (get-buffer-create spacemacs-buffer-name))
(setq initial-buffer-choice (lambda () (get-buffer spacemacs-buffer-name)))
(spacemacs-buffer/set-mode-line "")
;; no welcome buffer
(setq inhibit-startup-screen t)
;; silence ad-handle-definition about advised functions getting redefined
(setq ad-redefinition-action 'accept)
;; initialize the configuration layer system
(require 'core-configuration-layer)
(configuration-layer/initialize)
;; default theme
(let ((default-theme (car dotspacemacs-themes)))
(spacemacs/load-theme default-theme)
Expand Down Expand Up @@ -127,9 +128,9 @@ initialization."
;; dash is required to prevent a package.el bug with f on 24.3.1
(spacemacs/load-or-install-protected-package 'dash t)
(spacemacs/load-or-install-protected-package 's t)
(spacemacs/load-or-install-protected-package 'bind-map t)
;; bind-key is required by use-package
(spacemacs/load-or-install-protected-package 'bind-key t)
(spacemacs/load-or-install-protected-package 'bind-map t)
(spacemacs/load-or-install-protected-package 'use-package t)
(setq use-package-verbose init-file-debug)
;; package-build is required by quelpa
Expand Down
70 changes: 70 additions & 0 deletions core/libs/request-deferred.el
Original file line number Diff line number Diff line change
@@ -0,0 +1,70 @@
;;; request-deferred.el --- Wrap request.el by deferred

;; Copyright (C) 2012 Takafumi Arakaki

;; Author: Takafumi Arakaki <aka.tkf at gmail.com>
;; Package-Requires: ((deferred "0.3.1") (request "0.2.0"))
;; Version: 0.2.0

;; This file is NOT part of GNU Emacs.

;; request-deferred.el is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; request-deferred.el is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with request-deferred.el.
;; If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;;

;;; Code:

(require 'request)
(require 'deferred)

(defun request-deferred (url &rest args)
"Send a request and return deferred object associated with it.
Following deferred callback takes a response object regardless of
the response result. To make sure no error occurs during the
request, check `request-response-error-thrown'.
Arguments are the same as `request', but COMPLETE callback cannot
be used as it is used for starting deferred callback chain.
Example::
(require 'request-deferred)
(deferred:$
(request-deferred \"http://httpbin.org/get\" :parser 'json-read)
(deferred:nextc it
(lambda (response)
(message \"Got: %S\" (request-response-data response)))))
"

(let* ((d (deferred:new #'identity))
(callback-post (apply-partially
(lambda (d &rest args)
(deferred:callback-post
d (plist-get args :response)))
d)))
;; As `deferred:errorback-post' requires an error object to be
;; posted, use `deferred:callback-post' for success and error
;; cases.
(setq args (plist-put args :complete callback-post))
(apply #'request url args)
d))

(provide 'request-deferred)

;;; request-deferred.el ends here
Loading

9 comments on commit d822241

@swsnr
Copy link
Contributor

@swsnr swsnr commented on d822241 Dec 3, 2015

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Without having looked at the diff—sorry 😊—I presume that this implies vendoring request.el to support the bootstrap phase, doesn't it?

@TheBB
Copy link
Collaborator

@TheBB TheBB commented on d822241 Dec 3, 2015

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yeah, request.el is now in core/lib.

Maybe we should give it a new name so that packages can still depend on (and succesfully load) request.el from upstream?

@swsnr
Copy link
Contributor

@swsnr swsnr commented on d822241 Dec 3, 2015

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@TheBB I don't know, I guess that depends on when and where core/lib is put into load-path, and whether it's registered as a package for package.el. If it's put on load-path after package paths (i.e. added before calling package-initialize—I know, it's confusing) and not registered in package.el, it'd be safe I think because it's only loaded if request.el wasn't installed as a package, i.e. when spacemacs bootstraps.

OTOH, I think one could implement this with url-retrieve and with-timeout, but that's probably not really convenient.

@swsnr
Copy link
Contributor

@swsnr swsnr commented on d822241 Dec 3, 2015

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

But really, I don't know, I was just curious on how you've solved this problem, because Cask supposedly has the same problem—none reported it hitherto, but we're not doing anything with timeouts when we run package-refresh-contents during the bootstrapping phase.

@TheBB
Copy link
Collaborator

@TheBB TheBB commented on d822241 Dec 3, 2015

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

But if another package calls (require 'request), Emacs checks whether request is in the list of features, e.g. whether (featurep 'request) is true. If it is, nothing will happen, I believe, regardless of packages or load path.

Packages that depend on request will be able to download it and install it, but this version will take precedence since it's loaded before.

@swsnr
Copy link
Contributor

@swsnr swsnr commented on d822241 Dec 3, 2015

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@TheBB I'm not sure. If the package load path comes before core/lib, and a package has request.el in its requirements, i.e. would cause request.el to be installed as a dependency, then that request.el would go first in load-path.

Sure, that doesn't change anything for the current session, but if Emacs is restarted (require 'request) will hit the installed request.el, because it comes before the vendored one from core/lib.

IOW, the vendored library would only ever be used in the very first Spacemacs session, when Spacemacs has to bootstrap. After that, request.el is installed as a package and subsequent sessions would use the package.

I'm mostly guessing, though, and don't know whether Spacemacs really behaves that way.

@syl20bnr
Copy link
Owner Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If we can ditch the artificial inclusion on request.el in core/lib I'm all for it, I had an egg and chicken issue so I included it but it is far from ideal, relying on pure url.el would be ideal.

Actually I wonder why I went straight to request.el for this :-)

@syl20bnr
Copy link
Owner Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

More info on this:

  • while I was able to ping MELPA and GELPA, I was not able to ping orgmode.org
  • initially I wanted to use "HEAD" verb to not download the response body but in the end request.el does not support it

@syl20bnr
Copy link
Owner Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@lunaryorn @TheBB I removed the dependency on request.el in commit 741bd03

Please sign in to comment.