code.delx.au - gnu-emacs-elpa/blob - async-bytecomp.el

   1 ;;; async-bytecomp.el --- Async functions to compile elisp files async
   2
   3 ;; Copyright (C) 2014 John Wiegley
   4 ;; Copyright (C) 2014 Thierry Volpiatto
   5
   6 ;; Authors: John Wiegley <jwiegley@gmail.com>
   7 ;;          Thierry Volpiatto <thierry.volpiatto@gmail.com>
   8
   9 ;; Keywords: dired async byte-compile
  10 ;; X-URL: https://github.com/jwiegley/dired-async
  11
  12 ;; This program is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 2, or (at
  15 ;; your option) any later version.
  16
  17 ;; This program is distributed in the hope that it will be useful, but
  18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28 ;;
  29 ;;  This package provide the `async-byte-recompile-directory' function
  30 ;;  which allows, as the name says to recompile a directory outside of
  31 ;;  your running emacs.
  32 ;;  The benefit is your files will be compiled in a clean environment without
  33 ;;  the old *.el files loaded.
  34 ;;  Among other things, this fix a bug in package.el which recompile
  35 ;;  the new files in the current environment with the old files loaded, creating
  36 ;;  errors in most packages after upgrades.
  37 ;;
  38 ;;  NB: This package is advicing the function `package--compile'.
  39
  40 ;;; Code:
  41
  42 (require 'cl-lib)
  43 (require 'async)
  44
  45 (defcustom async-bytecomp-allowed-packages '(async helm)
  46   "Packages in this list will be compiled asynchronously by `package--compile'.
  47 All the dependencies of these packages will be compiled async too,
  48 so no need to add dependencies to this list.
  49 The value of this variable can also be the symbol `all', in this case
  50 packages are always compiled asynchronously."
  51   :group 'async
  52   :type '(repeat (choice symbol)))
  53
  54 (defvar async-byte-compile-log-file "~/.emacs.d/async-bytecomp.log")
  55
  56 (defun async-byte-recompile-directory (directory &optional quiet)
  57   "Compile all *.el files in DIRECTORY asynchronously.
  58 All *.elc files are systematically deleted before proceeding."
  59   (cl-loop with dir = (directory-files directory t "\\.elc\\'")
  60            unless dir return nil
  61            for f in dir
  62            when (file-exists-p f) do (delete-file f))
  63   ;; Ensure async is reloaded when async.elc is deleted.
  64   ;; This happen when recompiling its own directory.
  65   (load "async")
  66   (let ((call-back
  67          `(lambda (&optional ignore)
  68             (if (file-exists-p async-byte-compile-log-file)
  69                 (let ((buf (get-buffer-create byte-compile-log-buffer))
  70                       (n 0))
  71                   (with-current-buffer buf
  72                     (goto-char (point-max))
  73                     (let ((inhibit-read-only t))
  74                       (insert-file-contents async-byte-compile-log-file)
  75                       (compilation-mode))
  76                     (display-buffer buf)
  77                     (delete-file async-byte-compile-log-file)
  78                     (unless ,quiet
  79                       (save-excursion
  80                         (goto-char (point-min))
  81                         (while (re-search-forward "^.*:Error:" nil t)
  82                           (cl-incf n)))
  83                       (if (> n 0)
  84                           (message "Failed to compile %d files in directory `%s'" n ,directory)
  85                           (message "Directory `%s' compiled asynchronously with warnings" ,directory)))))
  86                 (unless ,quiet
  87                   (message "Directory `%s' compiled asynchronously with success" ,directory))))))
  88     (async-start
  89      `(lambda ()
  90         (require 'bytecomp)
  91         ,(async-inject-variables "\\`\\(load-path\\)\\|byte\\'")
  92         (let ((default-directory (file-name-as-directory ,directory))
  93               error-data)
  94           (add-to-list 'load-path default-directory)
  95           (byte-recompile-directory ,directory 0 t)
  96           (when (get-buffer byte-compile-log-buffer)
  97             (setq error-data (with-current-buffer byte-compile-log-buffer
  98                                (buffer-substring-no-properties (point-min) (point-max))))
  99             (unless (string= error-data "")
 100               (with-temp-file ,async-byte-compile-log-file
 101                 (erase-buffer)
 102                 (insert error-data))))))
 103      call-back)
 104     (message "Started compiling asynchronously directory %s" directory)))
 105
 106 (defvar package-archive-contents)
 107 (declare-function package-desc-reqs "package.el" (cl-x))
 108
 109 (defun async-bytecomp--get-package-deps (pkg &optional only)
 110   (let* ((pkg-desc (cadr (assq pkg package-archive-contents)))
 111          (direct-deps (cl-loop for p in (package-desc-reqs pkg-desc)
 112                                for name = (car p)
 113                                when (assq name package-archive-contents)
 114                                collect name))
 115          (indirect-deps (unless (eq only 'direct)
 116                           (delete-dups
 117                            (cl-loop for p in direct-deps append
 118                                     (async-bytecomp--get-package-deps p))))))
 119     (cl-case only
 120       (direct   direct-deps)
 121       (separate (list direct-deps indirect-deps))
 122       (indirect indirect-deps)
 123       (t        (delete-dups (append direct-deps indirect-deps))))))
 124
 125 (defun async-bytecomp-get-allowed-pkgs ()
 126   (when (and async-bytecomp-allowed-packages
 127              (listp async-bytecomp-allowed-packages))
 128     (cl-loop for p in async-bytecomp-allowed-packages
 129              append (async-bytecomp--get-package-deps p) into reqs
 130              finally return
 131              (delete-dups
 132               (append async-bytecomp-allowed-packages reqs)))))
 133
 134 (defadvice package--compile (around byte-compile-async activate)
 135   (let ((cur-package (package-desc-name pkg-desc)))
 136     (if (or (eq async-bytecomp-allowed-packages 'all)
 137             (memq cur-package (async-bytecomp-get-allowed-pkgs)))
 138         (progn
 139           (when (eq cur-package 'async)
 140             (fmakunbound 'async-byte-recompile-directory))
 141           (package-activate-1 pkg-desc)
 142           (load "async-bytecomp") ; emacs-24.3 don't reload new files.
 143           (async-byte-recompile-directory (package-desc-dir pkg-desc) t))
 144         ad-do-it)))
 145
 146
 147 (provide 'async-bytecomp)
 148
 149 ;;; async-bytecomp.el ends here