TakeV
/
spacemacs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Remove core .elc files on rev change

This commit is contained in:
JAremko 2021-01-25 03:06:28 +02:00 committed by Eugene Yaremenko
parent 31e443afd5
commit 0fd0af5d8c
3 changed files with 95 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
core/core-compilation.el
View File

@ -13,6 +13,8 @@
'(;; Built-in libs that we changed
"core/libs/forks/load-env-vars.el"
;; Rest of built-in libs.
"core/libs/packed.el"
"core/libs/auto-compile.el"
"core/libs/dash.el"
"core/libs/ht.el"
"core/libs/ido-vertical-mode.el"
@ -33,4 +35,13 @@ File paths are relative to the `spacemacs-start-directory'.")
(unless (file-exists-p (concat fbp ".elc"))
(byte-compile-file (concat fbp ".el"))))))
(defun spacemacs//remove-byte-compiled-files (files)
"Remove .elc files corresponding to the source FILES."
(dolist (file files)
(thread-last file
(file-truename)
(file-name-sans-extension)
(format "%s.elc")
(delete-file))))
(provide 'core-compilation)

104
core/core-release-management.el
View File

@ -36,6 +36,14 @@
"Time of last version check.")
(defvar spacemacs-version--startup-check-interval (* 3600 24)
"Minimum number of seconds between two version checks at startup.")
(defvar spacemacs-revision--last nil
"Last detected git revision of `spacemacs-start-directory' or nil.
NOTE: This variable will be set asynchronously after Spacemacs startup.")
(defvar spacemacs-revision--file
(expand-file-name (concat spacemacs-cache-directory "spacemacs-revision"))
"File where the last revision of `spacemacs-start-directory' is saved.")
(defvar spacemacs-revision--changed-hook nil
"Hooks to be ran when Spacemacs detects revision change.")
(defun spacemacs/switch-to-version (&optional version)
"Switch spacemacs to VERSION.
@ -194,18 +202,18 @@ OWNER REPO."
(defun spacemacs//git-has-remote (remote)
"Return non nil if REMOTE is declared."
(let ((proc-buffer "git-has-remote")
(default-directory (file-truename spacemacs-start-directory)))
(default-directory (file-truename spacemacs-start-directory)))
(when (eq 0 (process-file "git" nil proc-buffer nil "remote"))
(with-current-buffer proc-buffer
(prog2
(goto-char (point-min))
(re-search-forward (format "^%s$" remote) nil 'noerror)
(kill-buffer proc-buffer))))))
(with-current-buffer proc-buffer
(prog2
(goto-char (point-min))
(re-search-forward (format "^%s$" remote) nil 'noerror)
(kill-buffer proc-buffer))))))
(defun spacemacs//git-add-remote (remote url)
"Add a REMOTE with URL, return t if no error."
(let ((proc-buffer "git-add-remote")
(default-directory (file-truename spacemacs-start-directory)))
(default-directory (file-truename spacemacs-start-directory)))
(prog1
(eq 0 (process-file "git" nil proc-buffer nil
"remote" "add" remote url))
@ -214,7 +222,7 @@ OWNER REPO."
(defun spacemacs//git-remove-remote (remote)
"Remove a REMOTE, return t if no error."
(let ((proc-buffer "git-remove-remote")
(default-directory (file-truename spacemacs-start-directory)))
(default-directory (file-truename spacemacs-start-directory)))
(prog1
(eq 0 (process-file "git" nil proc-buffer nil
"remote" "remove" remote))
@ -223,7 +231,7 @@ OWNER REPO."
(defun spacemacs//git-fetch-remote (remote)
"Fetch last commits from REMOTE, return t if no error."
(let ((proc-buffer "git-fetch-remote")
(default-directory (file-truename spacemacs-start-directory)))
(default-directory (file-truename spacemacs-start-directory)))
(prog1
(eq 0 (process-file "git" nil proc-buffer nil
"fetch" remote))
@ -232,7 +240,7 @@ OWNER REPO."
(defun spacemacs//git-fetch-tags (remote branch)
"Fetch the tags for BRANCH in REMOTE repository."
(let ((proc-buffer "git-fetch-tags")
(default-directory (file-truename spacemacs-start-directory)))
(default-directory (file-truename spacemacs-start-directory)))
(prog1
;;;; original comment: seems necessary to fetch first
;; but we remove this according to issue #6692 proposal
@ -246,7 +254,7 @@ OWNER REPO."
(defun spacemacs//git-hard-reset-to-tag (tag)
"Hard reset the current branch to specified TAG."
(let ((proc-buffer "git-hard-reset")
(default-directory (file-truename spacemacs-start-directory)))
(default-directory (file-truename spacemacs-start-directory)))
(prog1
(eq 0 (process-file "git" nil proc-buffer nil
"reset" "--hard" tag))
@ -255,52 +263,52 @@ OWNER REPO."
(defun spacemacs//git-latest-tag (remote branch)
"Returns the latest tag on REMOTE/BRANCH."
(let ((proc-buffer "git-latest-tag")
(default-directory (file-truename spacemacs-start-directory))
(where (format "%s/%s" remote branch)))
(default-directory (file-truename spacemacs-start-directory))
(where (format "%s/%s" remote branch)))
(when (eq 0 (process-file "git" nil proc-buffer nil
"describe" "--tags" "--abbrev=0"
"--match=v*" where "FETCH_HEAD"))
(with-current-buffer proc-buffer
(prog1
(when (buffer-string)
(goto-char (point-max))
(forward-line -1)
(replace-regexp-in-string
"\n$" ""
(buffer-substring (line-beginning-position)
(line-end-position))))
(goto-char (point-max))
(forward-line -1)
(replace-regexp-in-string
"\n$" ""
(buffer-substring (line-beginning-position)
(line-end-position))))
(kill-buffer proc-buffer))))))
(defun spacemacs//git-checkout (branch)
"Checkout the given BRANCH. Return t if there is no error."
(let ((proc-buffer "git-checkout")
(default-directory (file-truename spacemacs-start-directory)))
(default-directory (file-truename spacemacs-start-directory)))
(prog1
(eq 0 (process-file "git" nil proc-buffer nil
"checkout" branch))
(kill-buffer proc-buffer))))
(defun spacemacs//git-get-current-branch ()
"Return the current branch. Return nil if an error occurred."
(let ((proc-buffer "git-get-current-branch")
"Return the current branch. Return nil if an error occurred."
(let ((proc-buffer "git-get-current-branch")
(default-directory (file-truename spacemacs-start-directory)))
(when (eq 0 (process-file "git" nil proc-buffer nil
"symbolic-ref" "--short" "-q" "HEAD"))
(with-current-buffer proc-buffer
(prog1
(when (buffer-string)
(goto-char (point-min))
(replace-regexp-in-string
"\n$" ""
(buffer-substring (line-beginning-position)
(line-end-position))))
(kill-buffer proc-buffer))))))
(when (eq 0 (process-file "git" nil proc-buffer nil
"symbolic-ref" "--short" "-q" "HEAD"))
(with-current-buffer proc-buffer
(prog1
(when (buffer-string)
(goto-char (point-min))
(replace-regexp-in-string
"\n$" ""
(buffer-substring (line-beginning-position)
(line-end-position))))
(kill-buffer proc-buffer))))))
(defun spacemacs//git-working-directory-dirty ()
"Non-nil if the user's emacs directory is not clean.
Returns the output of git status --porcelain."
(let ((proc-buffer "git-working-directory-dirty")
(default-directory (file-truename spacemacs-start-directory)))
(default-directory (file-truename spacemacs-start-directory)))
(when (eq 0 (process-file "git" nil proc-buffer nil
"status" "--porcelain"))
(with-current-buffer proc-buffer
@ -330,7 +338,7 @@ Returns the output of git status --porcelain."
Example: (1 42 3) = 1 042 003"
(let ((i -1))
(cl-reduce '+ (mapcar (lambda (n) (setq i (1+ i)) (* n (expt 10 (* i 3))))
(reverse version)))))
(reverse version)))))
(defun spacemacs/set-new-version-lighter-mode-line-faces ()
"Define or set the new version lighter mode-line faces."
@ -340,4 +348,30 @@ Example: (1 42 3) = 1 042 003"
(add-hook 'spacemacs-post-theme-change-hook
'spacemacs/set-new-version-lighter-mode-line-faces)
(defun spacemacs//revision-check ()
"Update saved value of the current revision asynchronously.
NOTE: If old and new revisions are different `spacemacs-revision--changed-hook'
will be triggered."
(when (file-exists-p spacemacs-revision--file)
(load spacemacs-revision--file nil t))
(require 'async)
(async-start
`(lambda ()
(let ((proc-buffer "spacemacs//revision-check:git-get-current-rev")
(default-directory (file-truename ,spacemacs-start-directory))
(new_rev))
(when (eq 0 (process-file "git" nil proc-buffer nil "rev-parse" "HEAD"))
(with-current-buffer proc-buffer
(goto-char 1)
(setq new_rev (current-word))
(kill-buffer proc-buffer)))
(with-temp-file ,spacemacs-revision--file
(insert (format "(setq spacemacs-revision--last %S)" new_rev))
(make-directory (file-name-directory ,spacemacs-revision--file) t))
new_rev))
(lambda (new_rev)
(unless (string= spacemacs-revision--last new_rev)
(setq spacemacs-revision--last new_rev)
(run-hooks 'spacemacs-revision--changed-hook)))))
(provide 'core-release-management)

19
core/core-spacemacs.el
View File

@ -159,9 +159,6 @@ the final step of executing code in `emacs-startup-hook'.")
(if (fboundp 'dotspacemacs/user-env)
(dotspacemacs/call-user-env)
(spacemacs/load-spacemacs-env))
;; Ensure that `spacemacs-compiled-files' are compiled.
(let ((default-directory spacemacs-start-directory))
(spacemacs//ensure-byte-compilation spacemacs-compiled-files))
;; install the dotfile if required
(dotspacemacs/maybe-install-dotfile))
@ -206,6 +203,12 @@ defer call using `spacemacs-post-user-config-hook'."
(funcall func)
(add-hook 'spacemacs-post-user-config-hook func)))
(defun spacemacs//byte-compile-cleanup ()
"Remove byte-compiled versions of `spacemacs-compiled-files'."
(let ((default-directory spacemacs-start-directory))
(spacemacs//remove-byte-compiled-files
spacemacs-compiled-files)))
(defun spacemacs/setup-startup-hook ()
"Add post init processing.
Note: the hooked function is not executed when in dumped mode."
@ -248,6 +251,14 @@ Note: the hooked function is not executed when in dumped mode."
(setq gc-cons-threshold (car dotspacemacs-gc-cons)
gc-cons-percentage (cadr dotspacemacs-gc-cons))
(unless (version< emacs-version "27")
(setq read-process-output-max dotspacemacs-read-process-output-max)))))
(setq read-process-output-max dotspacemacs-read-process-output-max))))
;; Ensure that `spacemacs-compiled-files' are byte-compiled.
(let ((default-directory spacemacs-start-directory))
(spacemacs//ensure-byte-compilation spacemacs-compiled-files))
;; Remove Spacemacs'es .elc files if Spacemacs revision has changed.
(add-hook 'spacemacs-revision--changed-hook 'spacemacs//byte-compile-cleanup)
;; Update saved revision.
(spacemacs//revision-check))
(provide 'core-spacemacs)