-;;; async-bytecomp.el --- Async functions to compile elisp files async
+;;; async-bytecomp.el --- Compile elisp files asynchronously -*- lexical-binding: t -*-
-;; Copyright (C) 2014 John Wiegley
-;; Copyright (C) 2014 Thierry Volpiatto
+;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
;; Authors: John Wiegley <jwiegley@gmail.com>
;; Thierry Volpiatto <thierry.volpiatto@gmail.com>
(require 'cl-lib)
(require 'async)
+(defcustom async-bytecomp-allowed-packages
+ '(async helm helm-core helm-ls-git helm-ls-hg magit)
+ "Packages in this list will be compiled asynchronously by `package--compile'.
+All the dependencies of these packages will be compiled async too,
+so no need to add dependencies to this list.
+The value of this variable can also be a list with a single element,
+the symbol `all', in this case packages are always compiled asynchronously."
+ :group 'async
+ :type '(repeat (choice symbol)))
+
(defvar async-byte-compile-log-file "~/.emacs.d/async-bytecomp.log")
-(defun async-byte-recompile-directory (directory &optional arg force)
+;;;###autoload
+(defun async-byte-recompile-directory (directory &optional quiet)
+ "Compile all *.el files in DIRECTORY asynchronously.
+All *.elc files are systematically deleted before proceeding."
(cl-loop with dir = (directory-files directory t "\\.elc\\'")
unless dir return nil
for f in dir
when (file-exists-p f) do (delete-file f))
;; Ensure async is reloaded when async.elc is deleted.
- ;; This happen when recompiling its directory.
+ ;; This happen when recompiling its own directory.
(load "async")
(let ((call-back
- `(lambda (&optional ignore)
- (if (file-exists-p async-byte-compile-log-file)
- (progn
- (pop-to-buffer (generate-new-buffer-name
- byte-compile-log-buffer))
- (erase-buffer)
- (insert-file-contents async-byte-compile-log-file)
- (compilation-mode)
- (delete-file async-byte-compile-log-file)
- (let ((n 0))
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "^.*:Error:" nil t)
- (incf n)))
- (if (> n 0)
- (message "Failed to compile %d files in directory `%s'" n ,directory)
- (message "Directory `%s' compiled asynchronously with warnings" ,directory))))
- (message "Directory `%s' compiled asynchronously with success" ,directory)))))
+ (lambda (&optional _ignore)
+ (if (file-exists-p async-byte-compile-log-file)
+ (let ((buf (get-buffer-create byte-compile-log-buffer))
+ (n 0))
+ (with-current-buffer buf
+ (goto-char (point-max))
+ (let ((inhibit-read-only t))
+ (insert-file-contents async-byte-compile-log-file)
+ (compilation-mode))
+ (display-buffer buf)
+ (delete-file async-byte-compile-log-file)
+ (unless quiet
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "^.*:Error:" nil t)
+ (cl-incf n)))
+ (if (> n 0)
+ (message "Failed to compile %d files in directory `%s'" n directory)
+ (message "Directory `%s' compiled asynchronously with warnings" directory)))))
+ (unless quiet
+ (message "Directory `%s' compiled asynchronously with success" directory))))))
(async-start
`(lambda ()
(require 'bytecomp)
- ,(async-inject-variables "\\`load-path\\'")
+ ,(async-inject-variables "\\`\\(load-path\\)\\|byte\\'")
(let ((default-directory (file-name-as-directory ,directory))
error-data)
(add-to-list 'load-path default-directory)
- (byte-recompile-directory ,directory ,arg ,force)
+ (byte-recompile-directory ,directory 0 t)
(when (get-buffer byte-compile-log-buffer)
(setq error-data (with-current-buffer byte-compile-log-buffer
(buffer-substring-no-properties (point-min) (point-max))))
(erase-buffer)
(insert error-data))))))
call-back)
- (message "Started compiling asynchronously directory %s..." directory)))
+ (unless quiet (message "Started compiling asynchronously directory %s" directory))))
+
+(defvar package-archive-contents)
+(defvar package-alist)
+(declare-function package-desc-reqs "package.el" (cl-x))
+
+(defun async-bytecomp--get-package-deps (pkg &optional only)
+ ;; Same as `package--get-deps' but parse instead `package-archive-contents'
+ ;; because PKG is not already installed and not present in `package-alist'.
+ ;; However fallback to `package-alist' in case PKG no more present
+ ;; in `package-archive-contents' due to modification to `package-archives'.
+ ;; See issue #58.
+ (let* ((pkg-desc (cadr (or (assq pkg package-archive-contents)
+ (assq pkg package-alist))))
+ (direct-deps (cl-loop for p in (package-desc-reqs pkg-desc)
+ for name = (car p)
+ when (or (assq name package-archive-contents)
+ (assq name package-alist))
+ collect name))
+ (indirect-deps (unless (eq only 'direct)
+ (delete-dups
+ (cl-loop for p in direct-deps append
+ (async-bytecomp--get-package-deps p))))))
+ (cl-case only
+ (direct direct-deps)
+ (separate (list direct-deps indirect-deps))
+ (indirect indirect-deps)
+ (t (delete-dups (append direct-deps indirect-deps))))))
+
+(defun async-bytecomp-get-allowed-pkgs ()
+ (when (and async-bytecomp-allowed-packages
+ (listp async-bytecomp-allowed-packages))
+ (if package-archive-contents
+ (cl-loop for p in async-bytecomp-allowed-packages
+ when (assq p package-archive-contents)
+ append (async-bytecomp--get-package-deps p) into reqs
+ finally return
+ (delete-dups
+ (append async-bytecomp-allowed-packages reqs)))
+ async-bytecomp-allowed-packages)))
+
+(defadvice package--compile (around byte-compile-async)
+ (let ((cur-package (package-desc-name pkg-desc))
+ (pkg-dir (package-desc-dir pkg-desc)))
+ (if (or (equal async-bytecomp-allowed-packages '(all))
+ (memq cur-package (async-bytecomp-get-allowed-pkgs)))
+ (progn
+ (when (eq cur-package 'async)
+ (fmakunbound 'async-byte-recompile-directory))
+ ;; Add to `load-path' the latest version of async and
+ ;; reload it when reinstalling async.
+ (when (string= cur-package "async")
+ (cl-pushnew pkg-dir load-path)
+ (load "async-bytecomp"))
+ ;; `async-byte-recompile-directory' will add directory
+ ;; as needed to `load-path'.
+ (async-byte-recompile-directory (package-desc-dir pkg-desc) t))
+ ad-do-it)))
-(defadvice package--compile (around byte-compile-async activate)
- (package-activate-1 pkg-desc)
- (async-byte-recompile-directory (package-desc-dir pkg-desc) 0 t))
+;;;###autoload
+(define-minor-mode async-bytecomp-package-mode
+ "Byte compile asynchronously packages installed with package.el.
+Async compilation of packages can be controlled by
+`async-bytecomp-allowed-packages'."
+ :group 'async
+ :global t
+ (if async-bytecomp-package-mode
+ (ad-activate 'package--compile)
+ (ad-deactivate 'package--compile)))
(provide 'async-bytecomp)