X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/b2b4bd62cf5c9d96a5a7a395e4f522044d47c7d4..af8933de25fda0be467055eaf83611acfce27c0b:/async-bytecomp.el diff --git a/async-bytecomp.el b/async-bytecomp.el index db92cf962..2c96da0ad 100644 --- a/async-bytecomp.el +++ b/async-bytecomp.el @@ -1,12 +1,10 @@ -;;; 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 ;; Thierry Volpiatto -;; Version: 1.0 ;; Keywords: dired async byte-compile ;; X-URL: https://github.com/jwiegley/dired-async @@ -40,41 +38,62 @@ ;;; Code: +(require 'cl-lib) (require 'async) -(defvar async-byte-compile-log-file "/tmp/async-bytecomp.log") +(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))) -(defun async-byte-recompile-directory (directory &optional arg force) +(defvar async-byte-compile-log-file "~/.emacs.d/async-bytecomp.log") + +;;;###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 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))) - (when (> n 0) - (message "Failed to compile %d files in directory `%s'" n ,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)))) @@ -83,11 +102,75 @@ (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)