From 9f1f0742c75276d45c1c328cd513c6c2d461b8a7 Mon Sep 17 00:00:00 2001 From: JAremko Date: Wed, 13 Jan 2021 12:50:55 +0200 Subject: [PATCH] Make sure that auto recompile starts asap --- .ci/built_in_manifest | 2 + core/libs/auto-compile.el | 789 ++++++++++++++++++++++++++++++++++++++ core/libs/packed.el | 510 ++++++++++++++++++++++++ early-init.el | 10 +- 4 files changed, 1310 insertions(+), 1 deletion(-) create mode 100644 core/libs/auto-compile.el create mode 100644 core/libs/packed.el diff --git a/.ci/built_in_manifest b/.ci/built_in_manifest index d9b35d560..1cac8228a 100644 --- a/.ci/built_in_manifest +++ b/.ci/built_in_manifest @@ -13,3 +13,5 @@ https://raw.githubusercontent.com/nashamri/spacemacs-theme/master/spacemacs-dark https://raw.githubusercontent.com/nashamri/spacemacs-theme/master/spacemacs-light-theme.el core/libs/spacemacs-theme/spacemacs-light-theme.el https://raw.githubusercontent.com/nashamri/spacemacs-theme/master/spacemacs-theme-pkg.el core/libs/spacemacs-theme/spacemacs-theme-pkg.el https://raw.githubusercontent.com/sigma/mocker.el/master/mocker.el core/libs/mocker.el +https://raw.githubusercontent.com/emacscollective/packed/master/packed.el core/libs/packed.el +https://raw.githubusercontent.com/emacscollective/auto-compile/master/auto-compile.el core/libs/auto-compile.el diff --git a/core/libs/auto-compile.el b/core/libs/auto-compile.el new file mode 100644 index 000000000..b0fd4a7a0 --- /dev/null +++ b/core/libs/auto-compile.el @@ -0,0 +1,789 @@ +;;; auto-compile.el --- automatically compile Emacs Lisp libraries -*- lexical-binding: t -*- + +;; Copyright (C) 2008-2020 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Homepage: https://github.com/emacscollective/auto-compile +;; Keywords: compile, convenience, lisp + +;; Package-Requires: ((emacs "25.1") (packed "3.0.1")) + +;; This file is not part of GNU Emacs. + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; For a full copy of the GNU General Public License +;; see . + +;;; Commentary: + +;; This package provides two minor modes which automatically recompile +;; Emacs Lisp source files. Together these modes guarantee that Emacs +;; never loads outdated byte code files. + +;; `auto-compile-on-save-mode' re-compiles source files when they are +;; being saved and `auto-compile-on-load-mode' does so before they are +;; being loaded (by advising `load' and `require'). Both modes only +;; ever _re-compile_ a source file when the respective byte code file +;; already exists but is outdated. Otherwise they do _not_ compile +;; the source file. + +;; Even when using `auto-compile-on-save-mode' it can happen that some +;; source file is newer than the respective byte code file, which is a +;; problem because by default Emacs loads the byte code file even when +;; the respective source file has been modified more recently. + +;; Starting with Emacs version 24.4, setting `load-prefer-newer' to t +;; prevents outdated byte code files from being loaded. However this +;; does not cause re-compilation of the source file, to actually do +;; that `auto-compile-on-load-mode' is still required. + +;; Setup +;; ----- + +;; To reduce the risk of loading outdated byte code files, you should +;; set `load-prefer-newer' and enable `auto-compile-on-load-mode' as +;; early as possible. Then also enable `auto-compile-on-save-mode'. +;; You should also consider not byte-compiling your personal init +;; file, or setting `load-prefer-newer' in a system-wide init file. + +;; If you use `package.el' then use something like this: +;; +;; ;;; init.el --- user init file +;; (setq load-prefer-newer t) +;; (package-initialize) +;; (require 'auto-compile) +;; (auto-compile-on-load-mode) +;; (auto-compile-on-save-mode) + +;; otherwise: +;; +;; ;;; init.el --- user init file +;; (setq load-prefer-newer t) +;; (add-to-list 'load-path "/path/to/packed") +;; (add-to-list 'load-path "/path/to/auto-compile") +;; (require 'auto-compile) +;; (auto-compile-on-load-mode) +;; (auto-compile-on-save-mode) + +;; You might want to set the file-local value of `no-byte-compile' to +;; t, e.g. by adding "-*- no-byte-compile: t -*-" (without the quotes) +;; at the end of the very first line. That way all user files benefit +;; from the protection offered by `load-prefer-newer' and the modes +;; that are defined here, otherwise `~/.emacs.d/init.el' is the only +;; exception. + +;; If you are using Emacs 27 or later, then these settings should be +;; placed in `early-init.el', which should never be compiled: + +;; ;;; early-init.el --- early bird -*- no-byte-compile: t -*- +;; (setq load-prefer-newer t) +;; (add-to-list 'load-path "/path/to/packed") +;; (add-to-list 'load-path "/path/to/auto-compile") +;; (require 'auto-compile) +;; (auto-compile-on-load-mode) +;; (auto-compile-on-save-mode) +;; ;;; early-init.el ends here + +;; Usage +;; ----- + +;; Take note of the compile warnings and fix them. + +;; To permanently or temporarily toggle automatic compilation of some +;; source file use the command `toggle-auto-compile'. Since the modes +;; only ever _update_ byte code files, toggling automatic compilation +;; is done simply by either creating the byte code file or by removing +;; it. `toggle-auto-compile' can also toggle automatic compilation of +;; multiple files at once; see its doc-string for more information. + +;; Customization +;; ------------- + +;; Constantly having the *Compile-Log* buffer pop up when a file is +;; being saved can quickly become annoying. Obviously the first thing +;; you should do to about that is to actually fix outstanding issues. + +;; Once you have done that you might also want to keep that buffer +;; from being automatically displayed and instead only show the number +;; of compile warnings for the current file in the mode-line. + +;; (setq auto-compile-display-buffer nil) +;; (setq auto-compile-mode-line-counter t) + +;; To display the buffer use `M-x auto-compile-display-log' or click +;; on the counter in the mode-line. + +;; Using `auto-compile-inhibit-compile-hook' it is possible to inhibit +;; automatic compilation under certain circumstances; e.g. when HEAD +;; is detached inside a Git repository (useful during rebase sessions). + +;;; Code: + +(require 'bytecomp) +(require 'cl-lib) +(require 'packed) + +(declare-function autoload-rubric "autoload") +(declare-function autoload-find-destination "autoload") +(declare-function autoload-file-load-name "autoload") +(declare-function autoload-generate-file-autoloads "autoload") + +(defvar autoload-modified-buffers) +(defvar warning-minimum-level) + +(defvar auto-compile-use-mode-line) + +(defgroup auto-compile nil + "Automatically compile Emacs Lisp source libraries." + :group 'convenience + :prefix 'auto-compile + :link '(function-link toggle-auto-compile) + :link '(function-link auto-compile-mode)) + +;;; Auto-Compile-On-Save Mode + +;;;###autoload +(define-minor-mode auto-compile-mode + "Compile Emacs Lisp source files after the visiting buffers are saved. + +After a buffer containing Emacs Lisp code is saved to its source +file update the respective byte code file. If the latter does +not exist do nothing. Therefore to disable automatic compilation +remove the byte code file. See command `toggle-auto-compile' for +a convenient way to do so. + +This mode should be enabled globally, using it's globalized +variant `auto-compile-on-save-mode'. Also see the related +`auto-compile-on-load-mode'." + :lighter auto-compile-mode-lighter + :group 'auto-compile + (unless (derived-mode-p 'emacs-lisp-mode) + (user-error "This mode only makes sense with emacs-lisp-mode")) + (if auto-compile-mode + (add-hook 'after-save-hook 'auto-compile-byte-compile nil t) + (remove-hook 'after-save-hook 'auto-compile-byte-compile t)) + (auto-compile-modify-mode-line auto-compile-use-mode-line)) + +;;;###autoload +(define-globalized-minor-mode auto-compile-on-save-mode + auto-compile-mode turn-on-auto-compile-mode) + +(defun turn-on-auto-compile-mode () + (when (eq major-mode 'emacs-lisp-mode) + (auto-compile-mode 1))) + +(defvar auto-compile-mode-lighter "" + "Mode lighter for Auto-Compile Mode.") + +;;; Options + +(defcustom auto-compile-visit-failed t + "Whether to visit source files which failed to compile. + +If this is non-nil visit but don't select a source file if it +isn't being visited in a buffer already. Also set the buffer +local value of variable `auto-compile-pretend-byte-compiled' +\(which see) to t and mark the buffer as modified if the value +of variable `auto-compile-mark-failed-modified' is non-nil." + :group 'auto-compile + :type 'boolean) + +(defcustom auto-compile-mark-failed-modified nil + "Whether to mark buffers which failed to compile as modified. + +This serves as a reminder to fix fatal errors. While useful this +can get annoying so this variable can be quickly toggled with the +command `auto-compile-toggle-mark-failed-modified'." + :group 'auto-compile + :type 'boolean) + +(defcustom auto-compile-ding t + "Whether to beep (or flash the screen) when an error occurs. + +Expected errors (such as compile error, unmatched parens, or +failure to remove a file) are caught and execution continues so +that failure to process one file does not prevent other files +from being processed. + +To inform users of such errors Auto-Compile instead beeps or +flashes the screen; set this variable to nil to disable even +that." + :group 'auto-compile + :type 'boolean) + +(defcustom auto-compile-check-parens t + "Whether to check for unbalanced parentheses before compiling. + +This only has as an effect on files which are currently being +visited in a buffer. Other files are compiled without performing +this check first. If unbalanced parentheses are found no attempt +is made to compile the file as that would obviously fail also." + :group 'auto-compile + :type 'boolean) + +(defcustom auto-compile-update-autoloads nil + "Whether to update autoloads after compiling. + +If no autoload file as specified by `packed-loaddefs-filename' can be +found quietly skip this step." + :group 'auto-compile + :type 'boolean) + +(defcustom auto-compile-inhibit-compile-hook nil + "Hook used to inhibit automatic compilation. + +This hook is run before automatic compilation takes place, if +any of the hook functions returns non-nil, then do not compile." + :group 'auto-compile + :options '(auto-compile-inhibit-compile-detached-git-head) + :type 'hook) + +(defcustom auto-compile-verbose nil + "Whether to print messages describing progress of byte-compiler. + +This overrides `byte-compile-verbose' but unlike that does not +default to t, and thus avoids unnecessary echo-area messages." + :group 'auto-compile + :type 'boolean) + +(defcustom auto-compile-display-buffer t + "Whether to automatically display the *Compile-Log* buffer. + +When there are errors then the buffer is always displayed, +when there are no warnings or errors it is never displayed." + :group 'auto-compile + :type 'boolean) + +(defcustom auto-compile-mode-line-counter nil + "Whether to display the number of warnings in the mode line. + +This assumes that `auto-compile-use-mode-line' (which see) is +non-nil." + :group 'auto-compile + :type 'boolean) + +(defun auto-compile-modify-mode-line (after) + (let ((format (delete 'mode-line-auto-compile + (default-value 'mode-line-format))) + cell) + (when (and after auto-compile-mode + (setq cell (member after format))) + (push 'mode-line-auto-compile (cdr cell))) + (set-default 'mode-line-format format))) + +(defcustom auto-compile-use-mode-line + (car (memq 'mode-line-modified (default-value 'mode-line-format))) + "Whether to show information about the byte code file in the mode line. + +This works by inserting `mode-line-auto-compile' into the default +value of `mode-line-format' after the construct (usually a symbol) +specified here. This happens every time local Auto-Compile mode +is turned on so the specified construct does not have to a member +of `mode-line-format' when this is set (this allows loading that +package after `auto-compile-on-load-mode' has been activated, so +that it can ensures the respective byte code file is up-to-date). + +If you want to add `mode-line-auto-compile' as a member of a +variable that is itself a member of `mode-line-format' then you +have to set this option to nil and manually modify that variable +to include `mode-line-auto-compile'." + :group 'auto-compile + :set (lambda (symbol value) + (set-default symbol value) + (auto-compile-modify-mode-line value)) + :type '(choice (const :tag "don't insert" nil) + (const :tag "after mode-line-modified" mode-line-modified) + (const :tag "after mode-line-remote" mode-line-remote) + (sexp :tag "after construct"))) + +(defcustom auto-compile-toggle-recompiles t + "Whether to recompile all source files when turning on compilation. + +When turning on auto compilation for multiple files at once +recompile source files even if their byte code file already +exist and are up-to-date. It's advisable to keep this enabled +to ensure changes to macros are picked up." + :group 'auto-compile + :type 'boolean) + +(defcustom auto-compile-delete-stray-dest t + "Whether to remove stray byte code files. + +If this is non-nil byte code files without a corresponding source +file are removed as they are encountered. This happens in the +functions `auto-compile-on-save' and `toggle-auto-compile'. The +main purpose of this functionality is to prevent leftover byte +code files from shadowing a source or byte code file in a +directory that comes later in the `load-path'." + :group 'auto-compile + :type 'boolean) + +(defcustom auto-compile-toggle-deletes-nonlib-dest nil + "Whether to delete non-library byte code files when toggling compilation." + :group 'auto-compile + :type 'boolean) + +(defcustom auto-compile-source-recreate-deletes-dest nil + "Whether to delete leftover byte code file when creating source file. + +When this is non-nil and saving a source buffer causes the file +to be created (as opposed to being overwritten) while its byte +code file already exists (because the source already existed and +was compiled in the past), then remove the latter (instead of +updating it by recompiling the source). This can e.g. happen +when switching git branches." + :group 'auto-compile + :type 'boolean) + +;;; Toggle and Perform Compilation + +;;;###autoload +(defun toggle-auto-compile (file action) + "Toggle automatic compilation of an Emacs Lisp source file or files. + +Read a file or directory name from the minibuffer defaulting to +the visited Emacs Lisp source file or `default-directory' if no +such file is being visited in the current buffer. + +If the user selects a file then automatic compilation of only +that file is toggled. Since both `auto-compile-on-save' and +`auto-compile-on-save' only ever _recompile_ byte code files, +toggling automatic compilation is done simply by creating or +removing the respective byte code file. + +If the user selects a directory then automatic compilation for +multiple files is toggled as follows: + +* With a positive prefix argument always compile source files; + with a negative prefix argument always remove byte code files. + +* Otherwise the existence or absence of the byte code file of + the source file that was current when this command was invoked + determines whether byte code files should be created or removed. + +* If no Emacs Lisp source file is being visited in the buffer + that was current when the command was invoked ask the user what + to do. + +* When _removing_ byte code files then all byte code files are + removed. If `auto-compile-deletes-stray-dest' is non-nil this + even includes byte code files for which no source file exists. + +* When _creating_ byte code files only do so for source files + that are actual libraries. Source files that provide the + correct feature are considered to be libraries; see + `packed-library-p'. + +* Note that non-libraries can still be automatically compiled, + you just cannot _recursively_ turn on automatic compilation + using this command. + +* When `auto-compile-toggle-recompiles' is non-nil recompile all + affected source files even when the respective source files are + up-to-date. Do so even for non-library source files. + +* Only enter subdirectories for which `packed-ignore-directory-p' + returns nil; i.e. don't enter hidden directories or directories + containing a file named \".nosearch\"." + (interactive + (let* ((file (and (eq major-mode 'emacs-lisp-mode) + (buffer-file-name))) + (action + (cond + (current-prefix-arg + (if (> (prefix-numeric-value current-prefix-arg) 0) + 'start + 'quit)) + (file + (if (file-exists-p (byte-compile-dest-file file)) + 'quit + 'start)) + (t + (pcase (read-char-choice + "Toggle automatic compilation (s=tart, q=uit, C-g)? " + '(?s ?q)) + (?s 'start) + (?q 'quit)))))) + (list (read-file-name (concat (capitalize (symbol-name action)) + " auto-compiling: ") + (and file (file-name-directory file)) + nil t + (and file (file-name-nondirectory file))) + action))) + (if (file-regular-p file) + (pcase action + (`start (auto-compile-byte-compile file t)) + (`quit (auto-compile-delete-dest (byte-compile-dest-file file)))) + (when (called-interactively-p 'any) + (let ((buffer (get-buffer byte-compile-log-buffer))) + (when (buffer-live-p buffer) + (kill-buffer buffer)))) + (dolist (f (directory-files file t)) + (cond + ((file-directory-p f) + (unless (packed-ignore-directory-p f) + (toggle-auto-compile f action))) + ((packed-library-p f) + (let ((dest (byte-compile-dest-file f))) + (if (eq action 'start) + (and (file-exists-p f) + (or auto-compile-toggle-recompiles + (file-newer-than-file-p f dest)) + (or (not (string-match "^\\.?#" (file-name-nondirectory f))) + (file-exists-p dest)) + (auto-compile-byte-compile f t)) + (auto-compile-delete-dest dest)))) + ((and auto-compile-toggle-deletes-nonlib-dest + (eq action 'quit) + (string-match (packed-el-regexp) f)) + (auto-compile-delete-dest (byte-compile-dest-file f))) + ((and auto-compile-delete-stray-dest + (string-match "\\.elc$" f) + (not (file-exists-p (packed-el-file f)))) + (auto-compile-delete-dest f)))))) + +(defalias 'auto-compile-toggle 'toggle-auto-compile) + +(defun auto-compile-toggle-mark-failed-modified () + "Toggle whether buffers which failed to compile are marked as modified." + (interactive) + (message (concat (if (setq auto-compile-mark-failed-modified + (not auto-compile-mark-failed-modified)) + "Mark " + "Don't mark ") + "files that failed to compile as modified"))) + +(defvar-local auto-compile-pretend-byte-compiled nil + "Whether to try again to compile this file after a failed attempt. + +Command `auto-compile-byte-compile' sets this buffer local +variable to t after failing to compile a source file being +visited in a buffer (or when variable `auto-compile-visit-failed' +is non-nil for all files being compiled) causing it to try again +when being called again. Command `toggle-auto-compile' will also +pretend the byte code file exists.") + +(defvar auto-compile-file-buffer nil) +(defvar-local auto-compile-warnings 0) + +(define-advice byte-compile-log-warning + (:before (_string &optional _fill _level) auto-compile) + "Increment local value of `auto-compile-warnings'." + (when auto-compile-file-buffer + (with-current-buffer auto-compile-file-buffer + (cl-incf auto-compile-warnings)))) + +(cl-defun auto-compile-byte-compile (&optional file start) + "Perform byte compilation for Auto-Compile mode." + (when (run-hook-with-args-until-success 'auto-compile-inhibit-compile-hook) + (cl-return-from auto-compile-byte-compile)) + (let ((default-directory default-directory) + dest buf auto-compile-file-buffer success loaddefs) + (when (and file + (setq buf (get-file-buffer file)) + (buffer-modified-p buf) + (y-or-n-p (format "Save buffer %s first? " (buffer-name buf)))) + (with-current-buffer buf (save-buffer))) + (unless file + (setq file (buffer-file-name)) + (setq buf (get-file-buffer file))) + (setq default-directory (file-name-directory file)) + (setq auto-compile-file-buffer buf) + (when (buffer-live-p buf) + (with-current-buffer buf + (setq auto-compile-warnings 0))) + (catch 'auto-compile + (when (and auto-compile-check-parens buf) + (condition-case check-parens + (save-restriction + (widen) + (check-parens)) + (error + (message (error-message-string check-parens)) + (auto-compile-handle-compile-error file buf start) + (throw 'auto-compile nil)))) + (setq dest (byte-compile-dest-file file)) + (when (or start + (and (file-exists-p dest) + (or (file-exists-p file) + (not auto-compile-source-recreate-deletes-dest) + (prog1 nil + (auto-compile-delete-dest dest)))) + (and (buffer-live-p buf) + (buffer-local-value auto-compile-pretend-byte-compiled + buf))) + (condition-case nil + (let ((byte-compile-verbose auto-compile-verbose) + (warning-minimum-level + (if auto-compile-display-buffer :warning :error))) + (setq success (packed-byte-compile-file file)) + (when (buffer-live-p buf) + (with-current-buffer buf + (kill-local-variable auto-compile-pretend-byte-compiled)))) + (file-error + (message "Byte-compiling %s failed" file) + (auto-compile-handle-compile-error file buf start) + (setq success nil))) + (when (and auto-compile-update-autoloads + (setq loaddefs (packed-loaddefs-file))) + (require 'autoload) + (condition-case nil + (packed-with-loaddefs loaddefs + (let ((autoload-modified-buffers nil)) + (autoload-generate-file-autoloads + file nil generated-autoload-file))) + (error + (message "Generating loaddefs for %s failed" file) + (setq loaddefs nil)))) + (pcase success + (`no-byte-compile) + (`t (message "Wrote %s.{%s,%s}%s" + (file-name-sans-extension + (file-name-sans-extension file)) + (progn (string-match "\\(\\.[^./]+\\)+$" file) + (substring (match-string 0 file) 1)) + (file-name-extension dest) + (if loaddefs " (+)" ""))) + (_ (message "Wrote %s (byte-compiling failed)" file)))) + success))) + +(defun auto-compile-delete-dest (dest &optional failurep) + (unless failurep + (let ((buffer (get-file-buffer (packed-el-file dest)))) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (kill-local-variable 'auto-compile-pretend-byte-compiled))))) + (condition-case nil + (when (file-exists-p dest) + (message "Deleting %s..." dest) + (delete-file dest) + (message "Deleting %s...done" dest)) + (file-error + (auto-compile-ding) + (message "Deleting %s...failed" dest)))) + +(defun auto-compile-handle-compile-error (file buf &optional start) + (auto-compile-ding) + (let (update) + (let ((dest (byte-compile-dest-file file))) + (when (file-exists-p dest) + (setq update t) + (auto-compile-delete-dest dest t))) + (when (or buf + (and auto-compile-visit-failed + (setq buf (find-file-noselect file)))) + (with-current-buffer buf + (when (or update start) + (setq auto-compile-pretend-byte-compiled t)) + (when auto-compile-mark-failed-modified + (set-buffer-modified-p t)))))) + +(defun auto-compile-handle-autoloads-error (dest) + (auto-compile-ding) + (packed-remove-autoloads dest nil)) + +(defun auto-compile-ding () + (when auto-compile-ding + (ding))) + +(define-advice save-buffers-kill-emacs + (:around (fn &optional arg) auto-compile) + "Bind `auto-compile-mark-failed-modified' to nil when killing Emacs. +If the regular value of this variable is non-nil the user might +still be asked whether she wants to save modified buffers, which +she actually did already safe. This advice ensures she at least +is only asked once about each such file." + (let ((auto-compile-mark-failed-modified nil)) + (funcall fn arg))) + +(define-advice save-buffers-kill-terminal + (:around (fn &optional arg) auto-compile) + "Bind `auto-compile-mark-failed-modified' to nil when killing Emacs. +If the regular value of this variable is non-nil the user might +still be asked whether she wants to save modified buffers, which +she actually did already safe. This advice ensures she at least +is only asked once about each such file." + (let ((auto-compile-mark-failed-modified nil)) + (funcall fn arg))) + +(defun auto-compile-inhibit-compile-detached-git-head () + "Inhibit compiling in Git repositories when `HEAD' is detached. +This is especially useful during rebase sessions." + (with-temp-buffer + (call-process "git" nil t nil "symbolic-ref" "HEAD") + (equal (buffer-string) "fatal: ref HEAD is not a symbolic ref\n"))) + +;;; Mode-Line + +(defvar-local mode-line-auto-compile + '(auto-compile-mode (:eval (mode-line-auto-compile-control)))) +(put 'mode-line-auto-compile 'risky-local-variable t) + +(defun mode-line-auto-compile-control () + (let ((src (buffer-file-name)) + dst) + (when (and src (setq dst (byte-compile-dest-file src))) + (list + (when (and auto-compile-mode-line-counter + (> auto-compile-warnings 0)) + (propertize + (format "%s" auto-compile-warnings) + 'help-echo (format "%s compile warnings\nmouse-1 display compile log" + auto-compile-warnings) + 'face 'error + 'mouse-face 'mode-line-highlight + 'local-map (purecopy (make-mode-line-mouse-map + 'mouse-1 + #'auto-compile-display-log)))) + (cond + ((file-writable-p dst) + (propertize + "-" + 'help-echo "Byte-compile destination is writable" + 'mouse-face 'mode-line)) + (t + (propertize + "%%" + 'help-echo "Byte-compile destination is read-only" + 'mouse-face 'mode-line))) + (cond + ((and auto-compile-pretend-byte-compiled + (not (file-exists-p dst))) + (propertize + "!" + 'help-echo "Failed to byte-compile updating\nmouse-1 retry" + 'mouse-face 'mode-line-highlight + 'local-map (purecopy (make-mode-line-mouse-map + 'mouse-1 + #'auto-compile-mode-line-byte-compile)))) + ((not (file-exists-p dst)) + (propertize + "%%" + 'help-echo "Byte-compiled file doesn't exist\nmouse-1 create" + 'mouse-face 'mode-line-highlight + 'local-map (purecopy (make-mode-line-mouse-map + 'mouse-1 + #'mode-line-toggle-auto-compile)))) + ((file-newer-than-file-p src dst) + (propertize + "*" + 'help-echo "Byte-compiled file needs updating\nmouse-1 update" + 'mouse-face 'mode-line-highlight + 'local-map (purecopy (make-mode-line-mouse-map + 'mouse-1 + #'auto-compile-mode-line-byte-compile)))) + (t + (propertize + "-" + 'help-echo "Byte-compiled file is up-to-date\nmouse-1 remove" + 'mouse-face 'mode-line-highlight + 'local-map (purecopy (make-mode-line-mouse-map + 'mouse-1 + #'mode-line-toggle-auto-compile))))))))) + +(defun auto-compile-display-log () + "Display the *Compile-Log* buffer." + (interactive) + (let ((buffer (get-buffer byte-compile-log-buffer))) + (if (buffer-live-p buffer) + (pop-to-buffer buffer) + (user-error "Buffer %s doesn't exist" byte-compile-log-buffer)))) + +(defun mode-line-toggle-auto-compile (event) + "Toggle automatic compilation from the mode-line." + (interactive "e") + (save-selected-window + (select-window (posn-window (event-start event))) + (toggle-auto-compile + (buffer-file-name) + (if (file-exists-p (byte-compile-dest-file (buffer-file-name))) + 'quit + 'start)) + (force-mode-line-update))) + +(defun auto-compile-mode-line-byte-compile (event) + "Recompile visited file from the mode-line." + (interactive "e") + (save-selected-window + (select-window (posn-window (event-start event))) + (auto-compile-byte-compile (buffer-file-name) t) + (force-mode-line-update))) + +;;; Auto-Compile-On-Load Mode + +;;;###autoload +(define-minor-mode auto-compile-on-load-mode + "Before loading a library recompile it if it needs recompilation. + +A library needs to be recompiled if the source file is newer than +it's byte-compile destination. Without this advice the outdated +byte code file would be loaded instead. + +Also see the related `auto-compile-on-save-mode'." + :lighter auto-compile-on-load-mode-lighter + :group 'auto-compile + :global t) + +(defvar auto-compile-on-load-mode-lighter "" + "Mode lighter for Auto-Compile-On-Load Mode.") + +(define-advice load + (:before (file &optional _noerror _nomessage nosuffix _must-suffix) + auto-compile) + "Before loading the library recompile it if it needs recompilation. +If `auto-compile-on-load-mode' isn't enabled, then do nothing. +It needs recompilation if it is newer than the byte-code file. +Without this advice the outdated source file would get loaded." + (when auto-compile-on-load-mode + (auto-compile-on-load file nosuffix))) + +(define-advice require + (:before (feature &optional filename _noerror) auto-compile) + "Before loading the library recompile it if it needs recompilation. +If `auto-compile-on-load-mode' isn't enabled, then do nothing. +It needs recompilation if it is newer than the byte-code file. +Without this advice the outdated source file would get loaded." + (when auto-compile-on-load-mode + (unless (featurep feature) + (auto-compile-on-load (or filename (symbol-name feature)))))) + +(defvar auto-compile--loading nil) + +(defun auto-compile-on-load (file &optional nosuffix) + (unless (member file auto-compile--loading) + (let ((auto-compile--loading (cons file auto-compile--loading)) + byte-compile-verbose el elc el*) + (condition-case nil + (when (setq el (packed-locate-library file nosuffix)) + (setq elc (byte-compile-dest-file el)) + (when (and (file-exists-p elc) + (file-writable-p elc) + (file-newer-than-file-p el elc)) + (message "Recompiling %s..." el) + (packed-byte-compile-file el) + (message "Recompiling %s...done" el)) + (when auto-compile-delete-stray-dest + (setq el* (locate-library file)) + (unless (equal (file-name-directory el) + (file-name-directory el*)) + (auto-compile-delete-dest el* t)))) + (error + (message "Recompiling %s...failed" el) + (when elc + (auto-compile-delete-dest elc t))))))) + +;;; _ +(provide 'auto-compile) +;; Local Variables: +;; indent-tabs-mode: nil +;; End: +;;; auto-compile.el ends here diff --git a/core/libs/packed.el b/core/libs/packed.el new file mode 100644 index 000000000..f1547922a --- /dev/null +++ b/core/libs/packed.el @@ -0,0 +1,510 @@ +;;; packed.el --- package manager agnostic Emacs Lisp package utilities -*- lexical-binding: t -*- + +;; Copyright (C) 2012-2020 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Homepage: https://github.com/emacscollective/packed +;; Keywords: compile, convenience, lisp, package, library +;; Package-Requires: ((emacs "24.3")) + +;; This file is not part of GNU Emacs. + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; For a full copy of the GNU General Public License +;; see . + +;;; Commentary: + +;; Packed provides some package manager agnostic utilities to work +;; with Emacs Lisp packages. As far as Packed is concerned packages +;; are collections of Emacs Lisp libraries that are stored in a +;; dedicated directory such as a Git repository. And libraries are +;; Emacs Lisp files that provide the correct feature (matching the +;; filename). + +;; Where a package manager might depend on metadata, Packed instead +;; uses some heuristics to get the same information — that is slower +;; and might also fail at times but makes it unnecessary to maintain +;; package recipes. + +;;; Code: + +(require 'bytecomp) +(require 'cl-lib) + +(defvar autoload-modified-buffers) +(declare-function autoload-rubric "autoload") +(declare-function autoload-find-destination "autoload") +(declare-function autoload-file-load-name "autoload") + +;;; Libraries + +(defun packed-el-suffixes (&optional nosuffix must-suffix) + "Return a list of the valid suffixes of Emacs Lisp source libraries. +Unlike `get-load-suffixes' don't return the suffixes for +byte-compile destinations just those of source files. + +If NOSUFFIX is non-nil the `.el' part is omitted. IF MUST-SUFFIX +is non-nil all returned suffixes contain `.el'. This uses the +variables `load-suffixes' (from which it removes \".elc\") and +`load-file-rep-suffixes'." + (packed--suffixes ".elc" nosuffix must-suffix)) + +(defun packed-elc-suffixes (&optional nosuffix must-suffix) + "Return a list of the valid suffixes of Emacs Lisp source libraries. +Unlike `get-load-suffixes' don't return the suffixes for +source files just those of byte-compile destinations. + +If NOSUFFIX is non-nil the `.elc' part is omitted. IF MUST-SUFFIX +is non-nil all returned suffixes contain `.elc'. This uses the +variables `load-suffixes' (from which it removes \".el\") and +`load-file-rep-suffixes'." + (packed--suffixes ".el" nosuffix must-suffix)) + +(defun packed--suffixes (remove-suffix &optional nosuffix must-suffix) + (append (unless nosuffix + (let ((load-suffixes (remove remove-suffix load-suffixes))) + (get-load-suffixes))) + (unless must-suffix + load-file-rep-suffixes))) + +(defun packed-el-regexp () + "Return the valid suffixes of Emacs libraries as a regular expression. +The returned regular expression matches source files but not +byte-compile destinations and always expects the \".el\" suffix." + (concat (regexp-opt (packed-el-suffixes nil t)) "\\'")) + +(defun packed-elc-regexp () + "Return the valid suffixes of byte-compile destinations as a regexp. +The returned regular expression matches byte-compile destinations +but not source files and always expects the \".elc\" suffix." + (concat (regexp-opt (packed-elc-suffixes nil t)) "\\'")) + +(defun packed-el-file (elc) + "Return the Emacs source file for byte-compile destination ELC." + (let ((standard (concat (file-name-sans-extension + (file-name-sans-extension elc)) ".el")) + (suffixes (remove ".el" (packed-el-suffixes))) + file) + (while (and (not file) suffixes) + (unless (file-exists-p (setq file (concat standard (pop suffixes)))) + (setq file nil))) + (or file standard))) + +(defalias 'packed-elc-file 'byte-compile-dest-file) + +(defun packed-locate-library (library &optional nosuffix path interactive-call) + "Show the precise file name of Emacs library LIBRARY. +Unlike `locate-library' don't return the byte-compile destination +if it exists but always the Emacs source file. + +LIBRARY should be a relative file name of the library, a string. +It can omit the suffix (a.k.a. file-name extension) if NOSUFFIX is +nil (which is the default, see below). +This command searches the directories in `load-path' like `\\[load-library]' +to find the file that `\\[load-library] RET LIBRARY RET' would load. +Optional second arg NOSUFFIX non-nil means don't add suffixes `load-suffixes' +to the specified name LIBRARY. + +If the optional third arg PATH is specified, that list of directories +is used instead of `load-path'. + +When called from a program, the file name is normally returned as a +string. When run interactively, the argument INTERACTIVE-CALL is t, +and the file name is displayed in the echo area." + (interactive (list (completing-read "Locate library: " + (apply-partially + 'locate-file-completion-table + load-path (get-load-suffixes))) + nil nil t)) + (let ((file (locate-file (substitute-in-file-name library) + (or path load-path) + (packed-el-suffixes nosuffix)))) + (when interactive-call + (if file + (message "Library is file %s" (abbreviate-file-name file)) + (message "No library %s in search path" library))) + file)) + +(defun packed-ignore-directory-p (directory) + "Return t if DIRECTORY is being ignored when searching for libraries. +DIRECTORY and all libraries it and its subdirectories contain +are being ignored if it contains a file named \".nosearch\" or +if it is a hidden directory." + (or (string-prefix-p "." (file-name-nondirectory + (directory-file-name directory))) + (file-exists-p (expand-file-name ".nosearch" directory)))) + +(defmacro packed-with-file (file &rest body) + "Execute BODY in a buffer containing the contents of FILE. +If FILE is nil or equal to `buffer-file-name' execute BODY in the +current buffer. Move to beginning of buffer before executing BODY. +FILE should be an Emacs lisp source file." + (declare (indent 1) (debug t)) + (let ((filesym (make-symbol "--file--"))) + `(let ((,filesym ,file)) + (save-match-data + (save-excursion + (if (and ,filesym (not (equal ,filesym buffer-file-name))) + (with-temp-buffer + (insert-file-contents ,filesym) + (setq buffer-file-name ,filesym) + (set-buffer-modified-p nil) + (with-syntax-table emacs-lisp-mode-syntax-table + ,@body)) + (goto-char (point-min)) + (with-syntax-table emacs-lisp-mode-syntax-table + ,@body))))))) + +(defun packed-library-p (file) + "Return non-nil if FILE is an Emacs source library. +Actually return the feature provided by FILE. + +An Emacs lisp file is considered to be a library if it provides +the correct feature; that is a feature that matches its filename +\(and possibly parts of the path leading to it)." + (and (let ((filename (file-name-nondirectory file))) + (save-match-data + (and (string-match (packed-el-regexp) filename) + (not (or (file-symlink-p file) + (string-equal filename dir-locals-file) + (auto-save-file-name-p filename)))))) + (packed-library-feature file))) + +(defun packed-libraries (directory &optional full nonrecursive) + "Return a list of libraries that are part of PACKAGE located in DIRECTORY. +DIRECTORY is assumed to contain the libraries belonging to a +single package. + +If optional FULL is non-nil return absolute paths otherwise paths +relative to DIRECTORY. + +If optional NONRECURSIVE only return libraries directly located +in DIRECTORY." + (cl-mapcan (pcase-lambda (`(,library . ,feature)) + (and feature + (list (if full + library + (file-relative-name library directory))))) + (packed-libraries-1 directory nonrecursive))) + +(defun packed-libraries-1 (directory &optional nonrecursive) + "Return a list of Emacs lisp files DIRECTORY and its subdirectories. + +The return value has the form ((LIBRARY . FEATURE)...). FEATURE +is nil if LIBRARY does not provide a feature or only features +that don't match the filename." + (let (libraries) + (dolist (f (directory-files directory t "^[^.]")) + (cond ((file-directory-p f) + (or nonrecursive + (packed-ignore-directory-p f) + (setq libraries (nconc (packed-libraries-1 f) libraries)))) + ((string-match (packed-el-regexp) + (file-name-nondirectory f)) + (push (cons f (packed-library-p f)) libraries)))) + (nreverse libraries))) + +(defun packed-main-library (directory &optional package noerror nosingle) + "Return the main library from the package directory DIRECTORY. +Optional PACKAGE is the name of the package; if it is nil the +basename of DIRECTORY is used as the package name. + +Return the library whose basename matches the package name. If +that fails append \"-mode\" to the package name, respectively +remove that substring, and try again. + +The library must provide the correct feature; that is the feature +which matches the filename (and possibly parts of the path leading +to it). + +Unless optional NOSINGLE is non-nil and if there is only a single +Emacs lisp file return that even if it doesn't match the package +name. + +If the main library cannot be found raise an error or if optional +NOERROR is non-nil return nil." + (packed-main-library-1 + (or package (file-name-nondirectory (directory-file-name directory))) + (packed-libraries-1 directory) + noerror nosingle)) + +(defun packed-main-library-1 (package libraries &optional noerror nosingle) + "Return the main library among LIBRARIES of the package PACKAGE. +PACKAGE is a package name, a string. LIBRARIES is a list of full +library filenames or an alist as returned by `packed-libraries-1'. +In the latter case also ensure that the main library provides the +correct feature. + +Return the library whose basename matches the package name. If +that fails append \"-mode\" to the package name, respectively +remove that substring, and try again. + +Unless optional NOSINGLE is non-nil and if there is only a single +Emacs lisp file return that even if it doesn't match the package +name. + +If no library matches raise an error or if optional NOERROR is +non-nil return nil." + (let ((match + (cond ((and (not nosingle) + (not (cdr libraries))) + (car libraries)) + ((packed-main-library-2 package libraries)) + ((packed-main-library-2 + (if (string-match "-mode$" package) + (substring package 0 -5) + (concat package "-mode")) + libraries))))) + (cond ((and (not match) + (not noerror)) + (error "Cannot determine main library of %s" package)) + ((atom match) + match) + ((cdr match) + (car match)) + ((not noerror) + (error "Main library %s provides no or wrong feature" + (car match)))))) + +(defun packed-main-library-2 (package libraries) + (let ((regexp (concat "^" (regexp-quote package) (packed-el-regexp) "$"))) + (cl-find-if (lambda (lib) + (string-match regexp (file-name-nondirectory + (if (consp lib) (car lib) lib)))) + libraries))) + +;;; Load Path + +(defun packed-add-to-load-path (directory) + "Add DIRECTORY and subdirectories to `load-path' if they contain libraries." + (dolist (d (packed-load-path directory)) + (add-to-list 'load-path d))) + +(defun packed-remove-from-load-path (directory) + "Remove DIRECTORY and its subdirectories from `load-path'. +Elements of `load-path' which no longer exist are not removed." + (setq directory (directory-file-name (expand-file-name directory))) + (setq load-path (delete directory load-path)) + (dolist (f (directory-files directory t "^[^.]" t)) + (when (file-directory-p f) + (packed-remove-from-load-path f)))) + +(defun packed-load-path (directory) + "Return a list of directories below DIRECTORY that contain libraries." + (let (lp in-lp) + (dolist (f (directory-files directory t "^[^.]")) + (cond ((file-regular-p f) + (and (not in-lp) + (packed-library-p f) + (push (directory-file-name directory) lp) + (setq in-lp t))) + ((file-directory-p f) + (unless (packed-ignore-directory-p f) + (setq lp (nconc (packed-load-path f) lp)))))) + lp)) + +;;; Byte Compile + +(defmacro packed-without-mode-hooks (&rest body) + (declare (indent 0)) + `(let (after-change-major-mode-hook + prog-mode-hook + emacs-lisp-mode-hook) + ,@body)) + +(defun packed-byte-compile-file (filename) + "Like `byte-compile-file' but don't run any mode hooks." + (packed-without-mode-hooks (byte-compile-file filename))) + +(defun packed-compile-package (directory &optional force) + (unless noninteractive + (save-some-buffers) + (force-mode-line-update)) + (with-current-buffer (get-buffer-create byte-compile-log-buffer) + (setq default-directory (expand-file-name directory)) + (unless (eq major-mode 'compilation-mode) + (compilation-mode)) + (let ((default-directory default-directory) + (skip-count 0) + (fail-count 0) + (lib-count 0) + (dir-count 0) + file dir last-dir) + (displaying-byte-compile-warnings + (dolist (elt (packed-libraries-1 directory)) + (setq file (car elt) + dir (file-name-nondirectory file)) + (if (cdr elt) + (cl-incf (pcase (byte-recompile-file file force 0) + (`no-byte-compile skip-count) + (`t lib-count) + (_ fail-count))) + (setq skip-count (1+ skip-count))) + (unless (eq last-dir dir) + (setq last-dir dir dir-count (1+ dir-count))))) + (message "Done (Total of %d file%s compiled%s%s%s)" + lib-count (if (= lib-count 1) "" "s") + (if (> fail-count 0) (format ", %d failed" fail-count) "") + (if (> skip-count 0) (format ", %d skipped" skip-count) "") + (if (> dir-count 1) + (format " in %d director%s" dir-count + (if (= dir-count 1) "y" "ies")) + ""))))) + +;;; Autoloads + +(defun packed-loaddefs-file (&optional file) + "Starting at FILE, look up directory hierarchy for an autoloads file. + +An autoloads file is either named \"loaddefs.el\" or its name ends +with \"-autoloads.el\". FILE can be a file or a directory. If +it's a file, its directory will serve as the starting point for +searching the hierarchy of directories. Stop at the first parent +directory containing such a file, and return the file. Return +nil if not found." + (unless file + (setq file default-directory)) + (setq file (abbreviate-file-name (expand-file-name file))) + (let (found) + (while (not (or found + (null file) + (string-match locate-dominating-stop-dir-regexp file))) + (unless (setq found + (car (directory-files + file t "\\(\\`loaddefs\\.el\\|-autoloads.el\\)\\'"))) + (when (equal file + (setq file + (file-name-directory (directory-file-name file)))) + (setq file nil)))) + found)) + +(defun packed-load-loaddefs (&optional directory) + (let ((file (packed-loaddefs-file directory))) + (if file + (load file) + (message "Cannot locate loaddefs file for %s" directory)))) + +(defmacro packed-with-loaddefs (dest &rest body) + (declare (indent 1)) + `(packed-without-mode-hooks + (require 'autoload) + (let ((generated-autoload-file ,dest) buf) + (prog1 (progn ,@body) + (while (setq buf (find-buffer-visiting generated-autoload-file)) + (with-current-buffer buf + (save-buffer) + (kill-buffer))))))) + +(defun packed-update-autoloads (dest path) + (packed-with-loaddefs dest + (cond ((fboundp 'make-directory-autoloads) ; >= 28 + (make-directory-autoloads path generated-autoload-file)) + ((fboundp 'update-directory-autoloads) ; <= 27 + (update-directory-autoloads path))))) + +(defun packed-remove-autoloads (dest path) + (packed-with-loaddefs dest + ;; `autoload-find-destination' clears out autoloads associated + ;; with a file if they are not found in the current buffer + ;; anymore (which is the case here because it is empty). + (with-temp-buffer + (let ((autoload-modified-buffers (list (current-buffer)))) + (dolist (d path) + (when (file-directory-p d) + (dolist (f (directory-files d t (packed-el-regexp))) + (autoload-find-destination + f (autoload-file-load-name f))))))))) + +;;; Features + +(defconst packed-provided-regexp "\ +\(\\(?:cc-\\|silentcomp-\\)?provide[\s\t\n]+'\ +\\([^(),\s\t\n]+\\)\\(?:[\s\t\n]+'\ +\(\\([^(),]+\\))\\)?)") + +(defun packed-provided () + (let (features) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward packed-provided-regexp nil t) + (unless (save-match-data + (or (nth 3 (syntax-ppss)) ; in string + (nth 4 (syntax-ppss)))) ; in comment + (dolist (feature (cons (match-string 1) + (let ((f (match-string 2))) + (and f (split-string f " " t))))) + (push (intern feature) features))))) + (or features + (and (goto-char (point-min)) + (re-search-forward + "^(provide-theme[\s\t\n]+'\\([^)]+\\))" nil t) + (list (intern (concat (match-string 1) + "-theme")))) + (and (goto-char (point-min)) + (re-search-forward + "^(provide-me\\(?:[\s\t\n]+\"\\(.+\\)\"\\)?)" nil t) + (list (intern (concat (match-string 1) + (file-name-sans-extension + (file-name-nondirectory + buffer-file-name))))))))) + +(defun packed-library-feature (file) + "Return the first valid feature actually provided by FILE. + +Here valid means that requiring that feature would actually load FILE. +Normally that is the case when the feature matches the filename, e.g. +when \"foo.el\" provides `foo'. But if \"foo.el\"s parent directory's +filename is \"bar\" then `bar/foo' would also be valid. Of course this +depends on the actual value of `load-path', here we just assume that it +allows for file to be found. + +This can be used to determine if an Emacs lisp file should be considered +a library. Not every Emacs lisp file has to provide a feature / be a +library. If a file lacks an expected feature then loading it using +`require' still succeeds but causes an error." + (let* ((file (expand-file-name file)) + (sans (file-name-sans-extension (file-name-sans-extension file))) + (last (file-name-nondirectory sans))) + (cl-find-if (lambda (feature) + (setq feature (symbol-name feature)) + (or (equal feature last) + (string-suffix-p (concat "/" feature) sans))) + (packed-with-file file (packed-provided))))) + +(defconst packed-required-regexp "\ +\(\\(?:cc-\\)?require[\s\t\n]+'\ +\\([^(),\s\t\n\"]+\\)\ +\\(?:\\(?:[\s\t\n]+\\(?:nil\\|\"[^\"]*\"\\)\\)\ +\\(?:[\s\t\n]+\\(?:nil\\|\\(t\\)\\)\\)?\\)?)") + +(defun packed-required () + (let (hard soft) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward packed-required-regexp nil t) + (let ((feature (intern (match-string 1)))) + (cond ((save-match-data + (or (nth 3 (syntax-ppss)) ; in string + (nth 4 (syntax-ppss))))) ; in comment + ((match-string 2) + (push feature soft)) + (t + (push feature hard)))))) + (list hard soft))) + +;;; _ +(provide 'packed) +;; Local Variables: +;; indent-tabs-mode: nil +;; End: +;;; packed.el ends here diff --git a/early-init.el b/early-init.el index b8930504e..07ff42252 100644 --- a/early-init.el +++ b/early-init.el @@ -1,4 +1,4 @@ -;;; early-init.el --- Spacemacs Early Init File +;;; early-init.el -*- no-byte-compile: t -*- --- Spacemacs Early Init File ;; ;; Copyright (c) 2020 Sylvain Benner & Contributors ;; @@ -22,3 +22,11 @@ ;; the package manager before loading the init file, so this file is neither ;; needed nor loaded on those versions. (setq package-enable-at-startup nil) + +;; Auto compilation. +(setq load-prefer-newer t) +(load (concat user-emacs-directory "core/libs/packed")) +(load (concat user-emacs-directory "core/libs/auto-compile")) +(auto-compile-on-load-mode) +(auto-compile-on-save-mode) +;;; early-init.el ends here