PageRenderTime 57ms CodeModel.GetById 22ms RepoModel.GetById 1ms app.codeStats 0ms

/auto-compile.el

https://github.com/tarsius/auto-compile
Emacs Lisp | 799 lines | 567 code | 116 blank | 116 comment | 22 complexity | f6f56ba2b0a1f5ad2a5c03f9a2acff15 MD5 | raw file
Possible License(s): GPL-3.0
  1. ;;; auto-compile.el --- automatically compile Emacs Lisp libraries -*- lexical-binding: t -*-
  2. ;; Copyright (C) 2008-2019 Jonas Bernoulli
  3. ;; Author: Jonas Bernoulli <jonas@bernoul.li>
  4. ;; Homepage: https://github.com/emacscollective/auto-compile
  5. ;; Keywords: compile, convenience, lisp
  6. ;; Package-Requires: ((emacs "25.1") (packed "3.0.0"))
  7. ;; This file is not part of GNU Emacs.
  8. ;; This file is free software; you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation; either version 3, or (at your option)
  11. ;; any later version.
  12. ;; This file is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. ;; GNU General Public License for more details.
  16. ;; For a full copy of the GNU General Public License
  17. ;; see <http://www.gnu.org/licenses/>.
  18. ;;; Commentary:
  19. ;; This package provides two minor modes which automatically recompile
  20. ;; Emacs Lisp source files. Together these modes guarantee that Emacs
  21. ;; never loads outdated byte code files.
  22. ;; `auto-compile-on-save-mode' re-compiles source files when they are
  23. ;; being saved and `auto-compile-on-load-mode' does so before they are
  24. ;; being loaded (by advising `load' and `require'). Both modes only
  25. ;; ever _re-compile_ a source file when the respective byte code file
  26. ;; already exists but is outdated. Otherwise they do _not_ compile
  27. ;; the source file.
  28. ;; Even when using `auto-compile-on-save-mode' it can happen that some
  29. ;; source file is newer than the respective byte code file, which is a
  30. ;; problem because by default Emacs loads the byte code file even when
  31. ;; the respective source file has been modified more recently.
  32. ;; Starting with Emacs version 24.4, setting `load-prefer-newer' to t
  33. ;; prevents outdated byte code files from being loaded. However this
  34. ;; does not cause re-compilation of the source file, to actually do
  35. ;; that `auto-compile-on-load-mode' is still required.
  36. ;; Setup
  37. ;; -----
  38. ;; To reduce the risk of loading outdated byte code files, you should
  39. ;; set `load-prefer-newer' and enable `auto-compile-on-load-mode' as
  40. ;; early as possible. Then also enable `auto-compile-on-save-mode'.
  41. ;; You should also consider not byte-compiling your personal init
  42. ;; file, or setting `load-prefer-newer' in a system-wide init file.
  43. ;; If you use `package.el' then use something like this:
  44. ;;
  45. ;; ;;; init.el --- user init file
  46. ;; (setq load-prefer-newer t)
  47. ;; (package-initialize)
  48. ;; (require 'auto-compile)
  49. ;; (auto-compile-on-load-mode)
  50. ;; (auto-compile-on-save-mode)
  51. ;; otherwise:
  52. ;;
  53. ;; ;;; init.el --- user init file
  54. ;; (setq load-prefer-newer t)
  55. ;; (add-to-list 'load-path "/path/to/packed")
  56. ;; (add-to-list 'load-path "/path/to/auto-compile")
  57. ;; (require 'auto-compile)
  58. ;; (auto-compile-on-load-mode)
  59. ;; (auto-compile-on-save-mode)
  60. ;; You might want to set the file-local value of `no-byte-compile' to
  61. ;; t, e.g. by adding "-*- no-byte-compile: t -*-" (without the quotes)
  62. ;; at the end of the very first line. That way all user files benefit
  63. ;; from the protection offered by `load-prefer-newer' and the modes
  64. ;; that are defined here, otherwise `~/.emacs.d/init.el' is the only
  65. ;; exception.
  66. ;; If you are using Emacs 27 or later, then these settings should be
  67. ;; placed in `early-init.el', which should never be compiled:
  68. ;; ;;; early-init.el --- early bird -*- no-byte-compile: t -*-
  69. ;; (setq load-prefer-newer t)
  70. ;; (add-to-list 'load-path "/path/to/packed")
  71. ;; (add-to-list 'load-path "/path/to/auto-compile")
  72. ;; (require 'auto-compile)
  73. ;; (auto-compile-on-load-mode)
  74. ;; (auto-compile-on-save-mode)
  75. ;; ;;; early-init.el ends here
  76. ;; Usage
  77. ;; -----
  78. ;; Take note of the compile warnings and fix them.
  79. ;; To permanently or temporarily toggle automatic compilation of some
  80. ;; source file use the command `toggle-auto-compile'. Since the modes
  81. ;; only ever _update_ byte code files, toggling automatic compilation
  82. ;; is done simply by either creating the byte code file or by removing
  83. ;; it. `toggle-auto-compile' can also toggle automatic compilation of
  84. ;; multiple files at once; see its doc-string for more information.
  85. ;; Customization
  86. ;; -------------
  87. ;; Constantly having the *Compile-Log* buffer pop up when a file is
  88. ;; being saved can quickly become annoying. Obviously the first thing
  89. ;; you should do to about that is to actually fix outstanding issues.
  90. ;; Once you have done that you might also want to keep that buffer
  91. ;; from being automatically displayed and instead only show the number
  92. ;; of compile warnings for the current file in the mode-line.
  93. ;; (setq auto-compile-display-buffer nil)
  94. ;; (setq auto-compile-mode-line-counter t)
  95. ;; To display the buffer use `M-x auto-compile-display-log' or click
  96. ;; on the counter in the mode-line.
  97. ;; Using `auto-compile-inhibit-compile-hook' it is possible to inhibit
  98. ;; automatic compilation under certain circumstances; e.g. when HEAD
  99. ;; is detached inside a Git repository (useful during rebase sessions).
  100. ;;; Code:
  101. (require 'bytecomp)
  102. (require 'cl-lib)
  103. (require 'packed)
  104. (declare-function autoload-rubric "autoload")
  105. (declare-function autoload-find-destination "autoload")
  106. (declare-function autoload-file-load-name "autoload")
  107. (declare-function autoload-generate-file-autoloads "autoload")
  108. (defvar autoload-modified-buffers)
  109. (defvar warning-minimum-level)
  110. (defvar auto-compile-update-autoloads)
  111. (defvar auto-compile-use-mode-line)
  112. (defgroup auto-compile nil
  113. "Automatically compile Emacs Lisp source libraries."
  114. :group 'convenience
  115. :prefix 'auto-compile
  116. :link '(function-link toggle-auto-compile)
  117. :link '(function-link auto-compile-mode))
  118. ;;; Auto-Compile-On-Save Mode
  119. ;;;###autoload
  120. (define-minor-mode auto-compile-mode
  121. "Compile Emacs Lisp source files after the visiting buffers are saved.
  122. After a buffer containing Emacs Lisp code is saved to its source
  123. file update the respective byte code file. If the latter does
  124. not exist do nothing. Therefore to disable automatic compilation
  125. remove the byte code file. See command `toggle-auto-compile' for
  126. a convenient way to do so.
  127. This mode should be enabled globally, using it's globalized
  128. variant `auto-compile-on-save-mode'. Also see the related
  129. `auto-compile-on-load-mode'."
  130. :lighter auto-compile-mode-lighter
  131. :group 'auto-compile
  132. (unless (derived-mode-p 'emacs-lisp-mode)
  133. (user-error "This mode only makes sense with emacs-lisp-mode"))
  134. (if auto-compile-mode
  135. (add-hook 'after-save-hook 'auto-compile-byte-compile nil t)
  136. (remove-hook 'after-save-hook 'auto-compile-byte-compile t))
  137. (auto-compile-modify-mode-line auto-compile-use-mode-line))
  138. ;;;###autoload
  139. (define-globalized-minor-mode auto-compile-on-save-mode
  140. auto-compile-mode turn-on-auto-compile-mode)
  141. (defun turn-on-auto-compile-mode ()
  142. (when (eq major-mode 'emacs-lisp-mode)
  143. (auto-compile-mode 1)))
  144. (defvar auto-compile-mode-lighter ""
  145. "Mode lighter for Auto-Compile Mode.")
  146. ;;; Options
  147. (defcustom auto-compile-visit-failed t
  148. "Whether to visit source files which failed to compile.
  149. If this is non-nil visit but don't select a source file if it
  150. isn't being visited in a buffer already. Also set the buffer
  151. local value of variable `auto-compile-pretend-byte-compiled'
  152. \(which see) to t and mark the buffer as modified if the value
  153. of variable `auto-compile-mark-failed-modified' is non-nil."
  154. :group 'auto-compile
  155. :type 'boolean)
  156. (defcustom auto-compile-mark-failed-modified nil
  157. "Whether to mark buffers which failed to compile as modified.
  158. This serves as a reminder to fix fatal errors. While useful this
  159. can get annoying so this variable can be quickly toggled with the
  160. command `auto-compile-toggle-mark-failed-modified'."
  161. :group 'auto-compile
  162. :type 'boolean)
  163. (defcustom auto-compile-ding t
  164. "Whether to beep (or flash the screen) when an error occurs.
  165. Expected errors (such as compile error, unmatched parens, or
  166. failure to remove a file) are caught and execution continues so
  167. that failure to process one file does not prevent other files
  168. from being processed.
  169. To inform users of such errors Auto-Compile instead beeps or
  170. flashes the screen; set this variable to nil to disable even
  171. that."
  172. :group 'auto-compile
  173. :type 'boolean)
  174. (defcustom auto-compile-check-parens t
  175. "Whether to check for unbalanced parentheses before compiling.
  176. This only has as an effect on files which are currently being
  177. visited in a buffer. Other files are compiled without performing
  178. this check first. If unbalanced parentheses are found no attempt
  179. is made to compile the file as that would obviously fail also."
  180. :group 'auto-compile
  181. :type 'boolean)
  182. (defcustom auto-compile-update-autoloads nil
  183. "Whether to update autoloads after compiling.
  184. If no autoload file as specified by `packed-loaddefs-filename' can be
  185. found quietly skip this step."
  186. :group 'auto-compile
  187. :type 'boolean)
  188. (defcustom auto-compile-inhibit-compile-hook nil
  189. "Hook used to inhibit automatic compilation.
  190. This hook is run before automatic compilation takes place, if
  191. any of the hook functions returns non-nil, then do not compile."
  192. :group 'auto-compile
  193. :options '(auto-compile-inhibit-compile-detached-git-head)
  194. :type 'hook)
  195. (defcustom auto-compile-verbose nil
  196. "Whether to print messages describing progress of byte-compiler.
  197. This overrides `byte-compile-verbose' but unlike that does not
  198. default to t, and thus avoids unnecessary echo-area messages."
  199. :group 'auto-compile
  200. :type 'boolean)
  201. (defcustom auto-compile-display-buffer t
  202. "Whether to automatically display the *Compile-Log* buffer.
  203. When there are errors then the buffer is always displayed,
  204. when there are no warnings or errors it is never displayed."
  205. :group 'auto-compile
  206. :type 'boolean)
  207. (defcustom auto-compile-mode-line-counter nil
  208. "Whether to display the number of warnings in the mode line.
  209. This assumes that `auto-compile-use-mode-line' (which see) is
  210. non-nil."
  211. :group 'auto-compile
  212. :type 'boolean)
  213. (defun auto-compile-modify-mode-line (after)
  214. (let ((format (delete 'mode-line-auto-compile
  215. (default-value 'mode-line-format)))
  216. cell)
  217. (when (and after auto-compile-mode
  218. (setq cell (member after format)))
  219. (push 'mode-line-auto-compile (cdr cell)))
  220. (set-default 'mode-line-format format)))
  221. (defcustom auto-compile-use-mode-line
  222. (car (memq 'mode-line-modified (default-value 'mode-line-format)))
  223. "Whether to show information about the byte code file in the mode line.
  224. This works by inserting `mode-line-auto-compile' into the default
  225. value of `mode-line-format' after the construct (usually a symbol)
  226. specified here. This happens every time local Auto-Compile mode
  227. is turned on so the specified construct does not have to a member
  228. of `mode-line-format' when this is set (this allows loading that
  229. package after `auto-compile-on-load-mode' has been activated, so
  230. that it can ensures the respective byte code file is up-to-date).
  231. If you want to add `mode-line-auto-compile' as a member of a
  232. variable that is itself a member of `mode-line-format' then you
  233. have to set this option to nil and manually modify that variable
  234. to include `mode-line-auto-compile'."
  235. :group 'auto-compile
  236. :set (lambda (symbol value)
  237. (set-default symbol value)
  238. (auto-compile-modify-mode-line value))
  239. :type '(choice (const :tag "don't insert" nil)
  240. (const :tag "after mode-line-modified" mode-line-modified)
  241. (const :tag "after mode-line-remote" mode-line-remote)
  242. (sexp :tag "after construct")))
  243. (defcustom auto-compile-toggle-recompiles t
  244. "Whether to recompile all source files when turning on compilation.
  245. When turning on auto compilation for multiple files at once
  246. recompile source files even if their byte code file already
  247. exist and are up-to-date. It's advisable to keep this enabled
  248. to ensure changes to macros are picked up."
  249. :group 'auto-compile
  250. :type 'boolean)
  251. (defcustom auto-compile-delete-stray-dest t
  252. "Whether to remove stray byte code files.
  253. If this is non-nil byte code files without a corresponding source
  254. file are removed as they are encountered. This happens in the
  255. functions `auto-compile-on-save' and `toggle-auto-compile'. The
  256. main purpose of this functionality is to prevent leftover byte
  257. code files from shadowing a source or byte code file in a
  258. directory that comes later in the `load-path'."
  259. :group 'auto-compile
  260. :type 'boolean)
  261. (defcustom auto-compile-toggle-deletes-nonlib-dest nil
  262. "Whether to delete non-library byte code files when toggling compilation."
  263. :group 'auto-compile
  264. :type 'boolean)
  265. (defcustom auto-compile-source-recreate-deletes-dest nil
  266. "Whether to delete leftover byte code file when creating source file.
  267. When this is non-nil and saving a source buffer causes the file
  268. to be created (as opposed to being overwritten) while its byte
  269. code file already exists (because the source already existed and
  270. was compiled in the past), then remove the latter (instead of
  271. updating it by recompiling the source). This can e.g. happen
  272. when switching git branches."
  273. :group 'auto-compile
  274. :type 'boolean)
  275. ;;; Toggle and Perform Compilation
  276. ;;;###autoload
  277. (defun toggle-auto-compile (file action)
  278. "Toggle automatic compilation of an Emacs Lisp source file or files.
  279. Read a file or directory name from the minibuffer defaulting to
  280. the visited Emacs Lisp source file or `default-directory' if no
  281. such file is being visited in the current buffer.
  282. If the user selects a file then automatic compilation of only
  283. that file is toggled. Since both `auto-compile-on-save' and
  284. `auto-compile-on-save' only ever _recompile_ byte code files,
  285. toggling automatic compilation is done simply by creating or
  286. removing the respective byte code file.
  287. If the user selects a directory then automatic compilation for
  288. multiple files is toggled as follows:
  289. * With a positive prefix argument always compile source files;
  290. with a negative prefix argument always remove byte code files.
  291. * Otherwise the existence or absence of the byte code file of
  292. the source file that was current when this command was invoked
  293. determines whether byte code files should be created or removed.
  294. * If no Emacs Lisp source file is being visited in the buffer
  295. that was current when the command was invoked ask the user what
  296. to do.
  297. * When _removing_ byte code files then all byte code files are
  298. removed. If `auto-compile-deletes-stray-dest' is non-nil this
  299. even includes byte code files for which no source file exists.
  300. * When _creating_ byte code files only do so for source files
  301. that are actual libraries. Source files that provide the
  302. correct feature are considered to be libraries; see
  303. `packed-library-p'.
  304. * Note that non-libraries can still be automatically compiled,
  305. you just cannot _recursively_ turn on automatic compilation
  306. using this command.
  307. * When `auto-compile-toggle-recompiles' is non-nil recompile all
  308. affected source files even when the respective source files are
  309. up-to-date. Do so even for non-library source files.
  310. * Only enter subdirectories for which `packed-ignore-directory-p'
  311. returns nil; i.e. don't enter hidden directories or directories
  312. containing a file named \".nosearch\"."
  313. (interactive
  314. (let* ((file (and (eq major-mode 'emacs-lisp-mode)
  315. (buffer-file-name)))
  316. (action
  317. (cond
  318. (current-prefix-arg
  319. (if (> (prefix-numeric-value current-prefix-arg) 0)
  320. 'start
  321. 'quit))
  322. (file
  323. (if (file-exists-p (byte-compile-dest-file file))
  324. 'quit
  325. 'start))
  326. (t
  327. (pcase (read-char-choice
  328. "Toggle automatic compilation (s=tart, q=uit, C-g)? "
  329. '(?s ?q))
  330. (?s 'start)
  331. (?q 'quit))))))
  332. (list (read-file-name (concat (capitalize (symbol-name action))
  333. " auto-compiling: ")
  334. (and file (file-name-directory file))
  335. nil t
  336. (and file (file-name-nondirectory file)))
  337. action)))
  338. (if (file-regular-p file)
  339. (pcase action
  340. (`start (auto-compile-byte-compile file t))
  341. (`quit (auto-compile-delete-dest (byte-compile-dest-file file))))
  342. (when (called-interactively-p 'any)
  343. (let ((buffer (get-buffer byte-compile-log-buffer)))
  344. (when buffer
  345. (kill-buffer buffer))))
  346. (dolist (f (directory-files file t))
  347. (cond
  348. ((file-directory-p f)
  349. (unless (packed-ignore-directory-p f)
  350. (toggle-auto-compile f action)))
  351. ((packed-library-p f)
  352. (let ((dest (byte-compile-dest-file f)))
  353. (if (eq action 'start)
  354. (and (file-exists-p f)
  355. (or auto-compile-toggle-recompiles
  356. (file-newer-than-file-p f dest))
  357. (or (not (string-match "^\\.?#" (file-name-nondirectory f)))
  358. (file-exists-p dest))
  359. (auto-compile-byte-compile f t))
  360. (auto-compile-delete-dest dest))))
  361. ((and auto-compile-toggle-deletes-nonlib-dest
  362. (eq action 'quit)
  363. (string-match (packed-el-regexp) f))
  364. (auto-compile-delete-dest (byte-compile-dest-file f)))
  365. ((and auto-compile-delete-stray-dest
  366. (string-match "\\.elc$" f)
  367. (not (file-exists-p (packed-el-file f))))
  368. (auto-compile-delete-dest f))))))
  369. (defalias 'auto-compile-toggle 'toggle-auto-compile)
  370. (defun auto-compile-toggle-mark-failed-modified ()
  371. "Toggle whether buffers which failed to compile are marked as modified."
  372. (interactive)
  373. (message (concat (if (setq auto-compile-mark-failed-modified
  374. (not auto-compile-mark-failed-modified))
  375. "Mark "
  376. "Don't mark ")
  377. "files that failed to compile as modified")))
  378. (defvar-local auto-compile-pretend-byte-compiled nil
  379. "Whether to try again to compile this file after a failed attempt.
  380. Command `auto-compile-byte-compile' sets this buffer local
  381. variable to t after failing to compile a source file being
  382. visited in a buffer (or when variable `auto-compile-visit-failed'
  383. is non-nil for all files being compiled) causing it to try again
  384. when being called again. Command `toggle-auto-compile' will also
  385. pretend the byte code file exists.")
  386. (defvar auto-compile-file-buffer nil)
  387. (defvar-local auto-compile-warnings 0)
  388. (define-advice byte-compile-log-warning
  389. (:before (_string &optional _fill _level) auto-compile)
  390. "Increment local value of `auto-compile-warnings'."
  391. (when auto-compile-file-buffer
  392. (with-current-buffer auto-compile-file-buffer
  393. (cl-incf auto-compile-warnings))))
  394. (cl-defun auto-compile-byte-compile (&optional file start)
  395. "Perform byte compilation for Auto-Compile mode."
  396. (when (run-hook-with-args-until-success 'auto-compile-inhibit-compile-hook)
  397. (cl-return-from auto-compile-byte-compile))
  398. (let ((default-directory default-directory)
  399. dest buf auto-compile-file-buffer success loaddefs)
  400. (when (and file
  401. (setq buf (get-file-buffer file))
  402. (buffer-modified-p buf)
  403. (y-or-n-p (format "Save buffer %s first? " (buffer-name buf))))
  404. (with-current-buffer buf (save-buffer)))
  405. (unless file
  406. (setq file (buffer-file-name))
  407. (setq buf (get-file-buffer file)))
  408. (setq default-directory (file-name-directory file))
  409. (setq auto-compile-file-buffer buf)
  410. (with-current-buffer buf
  411. (setq auto-compile-warnings 0))
  412. (catch 'auto-compile
  413. (when (and auto-compile-check-parens buf)
  414. (condition-case check-parens
  415. (save-restriction
  416. (widen)
  417. (check-parens))
  418. (error
  419. (message (error-message-string check-parens))
  420. (auto-compile-handle-compile-error file buf start)
  421. (throw 'auto-compile nil))))
  422. (setq dest (byte-compile-dest-file file))
  423. (when (or start
  424. (and (file-exists-p dest)
  425. (or (file-exists-p file)
  426. (not auto-compile-source-recreate-deletes-dest)
  427. (prog1 nil
  428. (auto-compile-delete-dest dest))))
  429. (and buf (with-current-buffer buf
  430. auto-compile-pretend-byte-compiled)))
  431. (condition-case nil
  432. (let ((byte-compile-verbose auto-compile-verbose)
  433. (warning-minimum-level
  434. (if auto-compile-display-buffer :warning :error)))
  435. (setq success (packed-byte-compile-file file))
  436. (when buf
  437. (with-current-buffer buf
  438. (kill-local-variable auto-compile-pretend-byte-compiled))))
  439. (file-error
  440. (message "Byte-compiling %s failed" file)
  441. (auto-compile-handle-compile-error file buf start)
  442. (setq success nil)))
  443. (when (and auto-compile-update-autoloads
  444. (setq loaddefs (packed-loaddefs-file)))
  445. (require 'autoload)
  446. (condition-case nil
  447. (packed-with-loaddefs loaddefs
  448. (let ((autoload-modified-buffers
  449. (list (find-buffer-visiting file))))
  450. (autoload-generate-file-autoloads file)))
  451. (error
  452. (message "Generating loaddefs for %s failed" file)
  453. (setq loaddefs nil))))
  454. (pcase success
  455. (`no-byte-compile)
  456. (`t (message "Wrote %s.{%s,%s}%s"
  457. (file-name-sans-extension
  458. (file-name-sans-extension file))
  459. (progn (string-match "\\(\\.[^./]+\\)+$" file)
  460. (substring (match-string 0 file) 1))
  461. (file-name-extension dest)
  462. (if loaddefs " (+)" "")))
  463. (_ (message "Wrote %s (byte-compiling failed)" file))))
  464. success)))
  465. (defun auto-compile-delete-dest (dest &optional failurep)
  466. (unless failurep
  467. (let ((buffer (get-file-buffer (packed-el-file dest))))
  468. (when buffer
  469. (with-current-buffer buffer
  470. (kill-local-variable 'auto-compile-pretend-byte-compiled)))))
  471. (condition-case nil
  472. (when (file-exists-p dest)
  473. (message "Deleting %s..." dest)
  474. (delete-file dest)
  475. (message "Deleting %s...done" dest))
  476. (file-error
  477. (auto-compile-ding)
  478. (message "Deleting %s...failed" dest))))
  479. (defun auto-compile-handle-compile-error (file buf &optional start)
  480. (auto-compile-ding)
  481. (let (update)
  482. (let ((dest (byte-compile-dest-file file)))
  483. (when (file-exists-p dest)
  484. (setq update t)
  485. (auto-compile-delete-dest dest t)))
  486. (when (or buf
  487. (and auto-compile-visit-failed
  488. (setq buf (find-file-noselect file))))
  489. (with-current-buffer buf
  490. (when (or update start)
  491. (setq auto-compile-pretend-byte-compiled t))
  492. (when auto-compile-mark-failed-modified
  493. (set-buffer-modified-p t))))))
  494. (defun auto-compile-handle-autoloads-error (dest)
  495. (auto-compile-ding)
  496. (packed-remove-autoloads dest nil))
  497. (defun auto-compile-ding ()
  498. (when auto-compile-ding
  499. (ding)))
  500. (define-advice save-buffers-kill-emacs
  501. (:around (fn &optional arg) auto-compile)
  502. "Bind `auto-compile-mark-failed-modified' to nil when killing Emacs.
  503. If the regular value of this variable is non-nil the user might
  504. still be asked whether she wants to save modified buffers, which
  505. she actually did already safe. This advice ensures she at least
  506. is only asked once about each such file."
  507. (let ((auto-compile-mark-failed-modified nil))
  508. (funcall fn arg)))
  509. (define-advice save-buffers-kill-terminal
  510. (:around (fn &optional arg) auto-compile)
  511. "Bind `auto-compile-mark-failed-modified' to nil when killing Emacs.
  512. If the regular value of this variable is non-nil the user might
  513. still be asked whether she wants to save modified buffers, which
  514. she actually did already safe. This advice ensures she at least
  515. is only asked once about each such file."
  516. (let ((auto-compile-mark-failed-modified nil))
  517. (funcall fn arg)))
  518. ;; REDEFINE autoload-save-buffers defined in autoload.el
  519. ;; - verify buffers are still live before killing them
  520. (eval-after-load 'autoload
  521. '(defun autoload-save-buffers ()
  522. (while autoload-modified-buffers
  523. (let ((buf (pop autoload-modified-buffers)))
  524. (when (buffer-live-p buf)
  525. (with-current-buffer buf
  526. (let ((version-control 'never))
  527. (save-buffer))))))))
  528. (defun auto-compile-inhibit-compile-detached-git-head ()
  529. "Inhibit compiling in Git repositories when `HEAD' is detached.
  530. This is especially useful during rebase sessions."
  531. (with-temp-buffer
  532. (call-process "git" nil t nil "symbolic-ref" "HEAD")
  533. (equal (buffer-string) "fatal: ref HEAD is not a symbolic ref\n")))
  534. ;;; Mode-Line
  535. (defvar-local mode-line-auto-compile
  536. '(auto-compile-mode (:eval (mode-line-auto-compile-control))))
  537. (put 'mode-line-auto-compile 'risky-local-variable t)
  538. (defun mode-line-auto-compile-control ()
  539. (let ((src (buffer-file-name))
  540. dst)
  541. (when (and src (setq dst (byte-compile-dest-file src)))
  542. (list
  543. (when (and auto-compile-mode-line-counter
  544. (> auto-compile-warnings 0))
  545. (propertize
  546. (format "%s" auto-compile-warnings)
  547. 'help-echo (format "%s compile warnings\nmouse-1 display compile log"
  548. auto-compile-warnings)
  549. 'face 'error
  550. 'mouse-face 'mode-line-highlight
  551. 'local-map (purecopy (make-mode-line-mouse-map
  552. 'mouse-1
  553. #'auto-compile-display-log))))
  554. (cond
  555. ((file-writable-p dst)
  556. (propertize
  557. "-"
  558. 'help-echo "Byte-compile destination is writable"
  559. 'mouse-face 'mode-line))
  560. (t
  561. (propertize
  562. "%%"
  563. 'help-echo "Byte-compile destination is read-only"
  564. 'mouse-face 'mode-line)))
  565. (cond
  566. ((and auto-compile-pretend-byte-compiled
  567. (not (file-exists-p dst)))
  568. (propertize
  569. "!"
  570. 'help-echo "Failed to byte-compile updating\nmouse-1 retry"
  571. 'mouse-face 'mode-line-highlight
  572. 'local-map (purecopy (make-mode-line-mouse-map
  573. 'mouse-1
  574. #'auto-compile-mode-line-byte-compile))))
  575. ((not (file-exists-p dst))
  576. (propertize
  577. "%%"
  578. 'help-echo "Byte-compiled file doesn't exist\nmouse-1 create"
  579. 'mouse-face 'mode-line-highlight
  580. 'local-map (purecopy (make-mode-line-mouse-map
  581. 'mouse-1
  582. #'mode-line-toggle-auto-compile))))
  583. ((file-newer-than-file-p src dst)
  584. (propertize
  585. "*"
  586. 'help-echo "Byte-compiled file needs updating\nmouse-1 update"
  587. 'mouse-face 'mode-line-highlight
  588. 'local-map (purecopy (make-mode-line-mouse-map
  589. 'mouse-1
  590. #'auto-compile-mode-line-byte-compile))))
  591. (t
  592. (propertize
  593. "-"
  594. 'help-echo "Byte-compiled file is up-to-date\nmouse-1 remove"
  595. 'mouse-face 'mode-line-highlight
  596. 'local-map (purecopy (make-mode-line-mouse-map
  597. 'mouse-1
  598. #'mode-line-toggle-auto-compile)))))))))
  599. (defun auto-compile-display-log ()
  600. "Display the *Compile-Log* buffer."
  601. (interactive)
  602. (let ((buffer (get-buffer byte-compile-log-buffer)))
  603. (if buffer
  604. (pop-to-buffer buffer)
  605. (user-error "Buffer %s doesn't exist" byte-compile-log-buffer))))
  606. (defun mode-line-toggle-auto-compile (event)
  607. "Toggle automatic compilation from the mode-line."
  608. (interactive "e")
  609. (save-selected-window
  610. (select-window (posn-window (event-start event)))
  611. (toggle-auto-compile
  612. (buffer-file-name)
  613. (if (file-exists-p (byte-compile-dest-file (buffer-file-name)))
  614. 'quit
  615. 'start))
  616. (force-mode-line-update)))
  617. (defun auto-compile-mode-line-byte-compile (event)
  618. "Recompile visited file from the mode-line."
  619. (interactive "e")
  620. (save-selected-window
  621. (select-window (posn-window (event-start event)))
  622. (auto-compile-byte-compile (buffer-file-name) t)
  623. (force-mode-line-update)))
  624. ;;; Auto-Compile-On-Load Mode
  625. ;;;###autoload
  626. (define-minor-mode auto-compile-on-load-mode
  627. "Before loading a library recompile it if it needs recompilation.
  628. A library needs to be recompiled if the source file is newer than
  629. it's byte-compile destination. Without this advice the outdated
  630. byte code file would be loaded instead.
  631. Also see the related `auto-compile-on-save-mode'."
  632. :lighter auto-compile-on-load-mode-lighter
  633. :group 'auto-compile
  634. :global t)
  635. (defvar auto-compile-on-load-mode-lighter ""
  636. "Mode lighter for Auto-Compile-On-Load Mode.")
  637. (define-advice load
  638. (:before (file &optional _noerror _nomessage nosuffix _must-suffix)
  639. auto-compile)
  640. "Before loading the library recompile it if it needs recompilation.
  641. If `auto-compile-on-load-mode' isn't enabled, then do nothing.
  642. It needs recompilation if it is newer than the byte-code file.
  643. Without this advice the outdated source file would get loaded."
  644. (when auto-compile-on-load-mode
  645. (auto-compile-on-load file nosuffix)))
  646. (define-advice require
  647. (:before (feature &optional filename _noerror) auto-compile)
  648. "Before loading the library recompile it if it needs recompilation.
  649. If `auto-compile-on-load-mode' isn't enabled, then do nothing.
  650. It needs recompilation if it is newer than the byte-code file.
  651. Without this advice the outdated source file would get loaded."
  652. (when auto-compile-on-load-mode
  653. (unless (featurep feature)
  654. (auto-compile-on-load (or filename (symbol-name feature))))))
  655. (defvar auto-compile--loading nil)
  656. (defun auto-compile-on-load (file &optional nosuffix)
  657. (unless (member file auto-compile--loading)
  658. (let ((auto-compile--loading (cons file auto-compile--loading))
  659. byte-compile-verbose el elc el*)
  660. (condition-case nil
  661. (when (setq el (packed-locate-library file nosuffix))
  662. (setq elc (byte-compile-dest-file el))
  663. (when (and (file-exists-p elc)
  664. (file-writable-p elc)
  665. (file-newer-than-file-p el elc))
  666. (message "Recompiling %s..." el)
  667. (packed-byte-compile-file el)
  668. (message "Recompiling %s...done" el))
  669. (when auto-compile-delete-stray-dest
  670. (setq el* (locate-library file))
  671. (unless (equal (file-name-directory el)
  672. (file-name-directory el*))
  673. (auto-compile-delete-dest el* t))))
  674. (error
  675. (message "Recompiling %s...failed" el)
  676. (when elc
  677. (auto-compile-delete-dest elc t)))))))
  678. ;;; _
  679. (provide 'auto-compile)
  680. ;; Local Variables:
  681. ;; indent-tabs-mode: nil
  682. ;; End:
  683. ;;; auto-compile.el ends here