Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

219 lines
9.5 KiB

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