daniel/emacs
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

update packages

Browse Source
This commit is contained in:
Daniel Weschke
2025-02-26 20:16:44 +01:00
parent 59db017445
commit 45d49daef0
291 changed files with 16240 additions and 522600 deletions
Download Patch File Download Diff File Expand all files Collapse all files

104
lisp/async/async-bytecomp.el
View File

@@ -22,17 +22,22 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; This package provide the `async-byte-recompile-directory' function
;; which allows, as the name says to recompile a directory outside of
;; your running emacs.
;; The benefit is your files will be compiled in a clean environment without
;; the old *.el files loaded.
;; Among other things, this fix a bug in package.el which recompile
;; the new files in the current environment with the old files loaded, creating
;; errors in most packages after upgrades.
;; your running emacs. Single files can be compiled with
;; `async-byte-compile-file'. The benefit is your files will be
;; compiled in a clean environment without the old *.el files
;; loaded. A mode `async-bytecomp-package-mode' is provided to
;; automatically compile packages asynchronously when installing or
;; upgrading, among other things, this fix a bug in package.el which
;; recompile the new files in the current environment with the old
;; files loaded, creating errors in most packages after upgrades.
;;
;; NB: This package is advicing the function `package--compile'.
;; NB: This package is advising the function `package--compile' when
;; `async-bytecomp-package-mode' is enabled. This mode is useful
;; only when using a synchronous package manager (e.g. M-x
;; list-package), users of M-x helm-packages don't need this anymore.
;;; Code:
@@ -60,6 +65,33 @@ all packages are always compiled asynchronously."
(defvar async-bytecomp-load-variable-regexp "\\`load-path\\'"
"The variable used by `async-inject-variables' when (re)compiling async.")
(defun async-bytecomp--file-to-comp-buffer (file-or-dir &optional quiet type)
(let ((bn (file-name-nondirectory file-or-dir))
(action-name (pcase type
('file "File")
('directory "Directory"))))
(if (file-exists-p async-byte-compile-log-file)
(let ((buf (get-buffer-create byte-compile-log-buffer))
(n 0))
(with-current-buffer buf
(goto-char (point-max))
(let ((inhibit-read-only t))
(insert-file-contents async-byte-compile-log-file)
(compilation-mode))
(display-buffer buf)
(delete-file async-byte-compile-log-file)
(unless quiet
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^.*:Error:" nil t)
(cl-incf n)))
(if (> n 0)
(message "Failed to compile %d files in directory `%s'" n bn)
(message "%s `%s' compiled asynchronously with warnings"
action-name bn)))))
(unless quiet
(message "%s `%s' compiled asynchronously with success" action-name bn)))))
;;;###autoload
(defun async-byte-recompile-directory (directory &optional quiet)
"Compile all *.el files in DIRECTORY asynchronously.
@@ -73,26 +105,7 @@ All *.elc files are systematically deleted before proceeding."
(load "async")
(let ((call-back
(lambda (&optional _ignore)
(if (file-exists-p async-byte-compile-log-file)
(let ((buf (get-buffer-create byte-compile-log-buffer))
(n 0))
(with-current-buffer buf
(goto-char (point-max))
(let ((inhibit-read-only t))
(insert-file-contents async-byte-compile-log-file)
(compilation-mode))
(display-buffer buf)
(delete-file async-byte-compile-log-file)
(unless quiet
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^.*:Error:" nil t)
(cl-incf n)))
(if (> n 0)
(message "Failed to compile %d files in directory `%s'" n directory)
(message "Directory `%s' compiled asynchronously with warnings" directory)))))
(unless quiet
(message "Directory `%s' compiled asynchronously with success" directory))))))
(async-bytecomp--file-to-comp-buffer directory quiet 'directory))))
(async-start
`(lambda ()
(require 'bytecomp)
@@ -140,13 +153,10 @@ All *.elc files are systematically deleted before proceeding."
(memq cur-package (async-bytecomp--get-package-deps
async-bytecomp-allowed-packages)))
(progn
;; FIXME: Why do we use (eq cur-package 'async) once
;; and (string= cur-package "async") afterwards?
(when (eq cur-package 'async)
(fmakunbound 'async-byte-recompile-directory))
;; Add to `load-path' the latest version of async and
;; reload it when reinstalling async.
(when (string= cur-package "async")
(fmakunbound 'async-byte-recompile-directory)
;; Add to `load-path' the latest version of async and
;; reload it when reinstalling async.
(cl-pushnew pkg-dir load-path)
(load "async-bytecomp"))
;; `async-byte-recompile-directory' will add directory
@@ -158,7 +168,10 @@ All *.elc files are systematically deleted before proceeding."
(define-minor-mode async-bytecomp-package-mode
"Byte compile asynchronously packages installed with package.el.
Async compilation of packages can be controlled by
`async-bytecomp-allowed-packages'."
`async-bytecomp-allowed-packages'.
NOTE: Use this mode only if you install/upgrade etc... your packages
synchronously, if you use a package manager like helm-package.el which
by default is async you don't need this."
:group 'async
:global t
(if async-bytecomp-package-mode
@@ -173,28 +186,13 @@ Same as `byte-compile-file' but asynchronous."
(interactive "fFile: ")
(let ((call-back
(lambda (&optional _ignore)
(let ((bn (file-name-nondirectory file)))
(if (file-exists-p async-byte-compile-log-file)
(let ((buf (get-buffer-create byte-compile-log-buffer))
start)
(with-current-buffer buf
(goto-char (setq start (point-max)))
(let ((inhibit-read-only t))
(insert-file-contents async-byte-compile-log-file)
(compilation-mode))
(display-buffer buf)
(delete-file async-byte-compile-log-file)
(save-excursion
(goto-char start)
(if (re-search-forward "^.*:Error:" nil t)
(message "Failed to compile `%s'" bn)
(message "`%s' compiled asynchronously with warnings" bn)))))
(message "`%s' compiled asynchronously with success" bn))))))
(async-bytecomp--file-to-comp-buffer file nil 'file))))
(async-start
`(lambda ()
(require 'bytecomp)
,(async-inject-variables async-bytecomp-load-variable-regexp)
(let ((default-directory ,(file-name-directory file)))
(let ((default-directory ,(file-name-directory file))
error-data)
(add-to-list 'load-path default-directory)
(byte-compile-file ,file)
(when (get-buffer byte-compile-log-buffer)

145
lisp/async/async-package.el Normal file
View File

@@ -0,0 +1,145 @@
;;; async-package.el --- Fetch packages asynchronously -*- lexical-binding: t -*-
;; Copyright (C) 2014-2022 Free Software Foundation, Inc.
;; Author: Thierry Volpiatto <thievol@posteo.net>
;; Keywords: dired async byte-compile package
;; X-URL: https://github.com/jwiegley/emacs-async
;; This program 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 of the License, or
;; (at your option) any later version.
;; This program 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.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Provide the function `async-package-do-action' to
;; (re)install/upgrade packages asynchronously.
;;; Code:
(eval-when-compile (require 'cl-lib))
(require 'async-bytecomp)
(require 'dired-async)
(require 'package)
(define-minor-mode async-package--modeline-mode
"Notify mode-line that an async process run."
:group 'async
:global t
:lighter (:eval (propertize (format " [%s async job Installing package(s)]"
(length (dired-async-processes
'async-pkg-install)))
'face 'async-package-message))
(unless async-package--modeline-mode
(let ((visible-bell t)) (ding))))
(defvar async-pkg-install-after-hook nil
"Hook that run after package installation.
The hook runs in the call-back once installation is done in child emacs.")
(defface async-package-message
'((t (:foreground "yellow")))
"Face used for mode-line message."
:group 'async)
(defun async-package-do-action (action packages error-file)
"Execute ACTION asynchronously on PACKAGES.
Argument ACTION can be one of \\='install, \\='upgrade, \\='reinstall.
Argument PACKAGES is a list of packages (symbols).
Argument ERROR-FILE is the file where errors are logged, if some."
(require 'async-bytecomp)
(let ((fn (pcase action
('install 'package-install)
('upgrade 'package-upgrade)
('reinstall 'package-reinstall)))
(action-string (pcase action
('install "Installing")
('upgrade "Upgrading")
('reinstall "Reinstalling"))))
(message "%s %s package(s)..." action-string (length packages))
(process-put
(async-start
`(lambda ()
(require 'bytecomp)
(setq package-archives ',package-archives
package-pinned-packages ',package-pinned-packages
package-archive-contents ',package-archive-contents
package-user-dir ,package-user-dir
package-alist ',package-alist
load-path ',load-path)
;; Ensure `async-bytecomp-package-mode' doesn't kick in
;; (issue #194) as some packages may enable it
;; inconditionally. We don't need to compile async as we are
;; already async and in a clean environment.
(require 'async-bytecomp)
(setq async-bytecomp-allowed-packages nil)
(prog1
(condition-case err
(mapc ',fn ',packages)
(error
(with-temp-file ,error-file
(insert
(format
"%S:\n Please refresh package list before %s"
err ,action-string)))))
(let (error-data)
(when (get-buffer byte-compile-log-buffer)
(setq error-data (with-current-buffer byte-compile-log-buffer
(buffer-substring-no-properties
(point-min) (point-max))))
(unless (string= error-data "")
(with-temp-file ,async-byte-compile-log-file
(erase-buffer)
(insert error-data)))))))
(lambda (result)
(if (file-exists-p error-file)
(let ((buf (find-file-noselect error-file)))
(pop-to-buffer
buf '(nil . ((window-height . fit-window-to-buffer))))
(special-mode)
(delete-file error-file)
(async-package--modeline-mode -1))
(when result
(let ((pkgs (if (listp result) result (list result))))
(when (eq action 'install)
(customize-save-variable
'package-selected-packages
(delete-dups (append pkgs package-selected-packages))))
(package-load-all-descriptors) ; refresh package-alist.
(mapc #'package-activate pkgs) ; load packages.
(async-package--modeline-mode -1)
(message "%s %s packages done" action-string (length packages))
(run-with-timer
0.1 nil
(lambda (lst str)
(dired-async-mode-line-message
"%s %d package(s) done"
'async-package-message
str (length lst)))
packages action-string)
(when (file-exists-p async-byte-compile-log-file)
(let ((buf (get-buffer-create byte-compile-log-buffer)))
(with-current-buffer buf
(goto-char (point-max))
(let ((inhibit-read-only t))
(insert-file-contents async-byte-compile-log-file)
(compilation-mode))
(display-buffer buf)
(delete-file async-byte-compile-log-file)))))))
(run-hooks 'async-pkg-install-after-hook)))
'async-pkg-install t)
(async-package--modeline-mode 1)))
(provide 'async-package)
;;; async-package.el ends here

4
lisp/async/async-pkg.el
View File

@@ -1,6 +1,6 @@
(define-package "async" "20230528.622" "Asynchronous processing in Emacs"
(define-package "async" "20241126.810" "Asynchronous processing in Emacs"
'((emacs "24.4"))
:commit "3ae74c0a4ba223ba373e0cb636c385e08d8838be" :authors
:commit "b99658e831bc7e7d20ed4bb0a85bdb5c7dd74142" :authors
'(("John Wiegley" . "jwiegley@gmail.com"))
:maintainers
'(("Thierry Volpiatto" . "thievol@posteo.net"))

72
lisp/async/async.el
View File

@@ -6,7 +6,7 @@
;; Maintainer: Thierry Volpiatto <thievol@posteo.net>
;; Created: 18 Jun 2012
;; Version: 1.9.7
;; Version: 1.9.9
;; Package-Requires: ((emacs "24.4"))
;; Keywords: async
@@ -34,6 +34,8 @@
(eval-when-compile (require 'cl-lib))
(defvar tramp-password-prompt-regexp)
(defgroup async nil
"Simple asynchronous processing in Emacs"
:group 'lisp)
@@ -42,6 +44,19 @@
"Default function to remove text properties in variables."
:type 'function)
(defcustom async-prompt-for-password t
"Prompt for password in parent Emacs if needed when non nil.
When this is nil child Emacs will hang forever when a user interaction
for password is required unless a password is stored in a \".authinfo\" file."
:type 'boolean)
(defvar async-process-noquery-on-exit nil
"Used as the :noquery argument to `make-process'.
Intended to be let-bound around a call to `async-start' or
`async-start-process'. If non-nil, the child Emacs process will
be silently killed if the user exits the parent Emacs.")
(defvar async-debug nil)
(defvar async-send-over-pipe t)
(defvar async-in-child-emacs nil)
@@ -102,14 +117,17 @@ is returned unmodified."
collect elm))
(t object)))
(defvar async-inject-variables-exclude-regexps '("-syntax-table\\'")
"A list of regexps that `async-inject-variables' should ignore.")
(defun async-inject-variables
(include-regexp &optional predicate exclude-regexp noprops)
"Return a `setq' form that replicates part of the calling environment.
It sets the value for every variable matching INCLUDE-REGEXP and
also PREDICATE. It will not perform injection for any variable
matching EXCLUDE-REGEXP (if present) or representing a `syntax-table'
i.e. ending by \"-syntax-table\".
matching EXCLUDE-REGEXP (if present) and variables matching one of
`async-inject-variables-exclude-regexps'.
When NOPROPS is non nil it tries to strip out text properties of each
variable's value with `async-variables-noprops-function'.
@@ -128,14 +146,16 @@ It is intended to be used as follows:
,@(let (bindings)
(mapatoms
(lambda (sym)
(let* ((sname (and (boundp sym) (symbol-name sym)))
(value (and sname (symbol-value sym))))
(let ((sname (and (boundp sym) (symbol-name sym)))
value)
(when (and sname
(or (null include-regexp)
(string-match include-regexp sname))
(or (null exclude-regexp)
(not (string-match exclude-regexp sname)))
(not (string-match "-syntax-table\\'" sname)))
(cl-loop for re in async-inject-variables-exclude-regexps
never (string-match-p re sname)))
(setq value (symbol-value sym))
(unless (or (stringp value)
(memq value '(nil t))
(numberp value)
@@ -207,7 +227,7 @@ It is intended to be used as follows:
(process-name proc) (process-exit-status proc))))
(set (make-local-variable 'async-callback-value-set) t))))))
(defun async-read-from-client (proc string)
(defun async-read-from-client (proc string &optional prompt-for-pwd)
"Process text from client process.
The string chunks usually arrive in maximum of 4096 bytes, so a
@@ -217,8 +237,18 @@ function.
We use a marker `async-read-marker' to track the position of the
lasts complete line. Every time we get new input, we try to look
for newline, and if found, process the entire line and bump the
marker position to the end of this next line."
marker position to the end of this next line.
Argument PROMPT-FOR-PWD allow binding lexically the value of
`async-prompt-for-password', if unspecified its global value
is used."
(with-current-buffer (process-buffer proc)
(when (and prompt-for-pwd
(boundp 'tramp-password-prompt-regexp)
tramp-password-prompt-regexp
(string-match tramp-password-prompt-regexp string))
(process-send-string
proc (concat (read-passwd (match-string 0 string)) "\n")))
(goto-char (point-max))
(save-excursion
(insert string))
@@ -350,7 +380,7 @@ its FINISH-FUNC is nil."
(plist-get value :async-message)))
(defun async-send (process-or-key &rest args)
"Send the given message to the asychronous child or parent Emacs.
"Send the given message to the asynchronous child or parent Emacs.
To send messages from the parent to a child, PROCESS-OR-KEY is
the child process object. ARGS is a plist. Example:
@@ -402,12 +432,14 @@ finished. Set DEFAULT-DIRECTORY to change PROGRAM's current
working directory."
(let* ((buf (generate-new-buffer (concat "*" name "*")))
(buf-err (generate-new-buffer (concat "*" name ":err*")))
(prt-for-pwd async-prompt-for-password)
(proc (let ((process-connection-type nil))
(make-process
:name name
:buffer buf
:stderr buf-err
:command (cons program program-args)))))
:command (cons program program-args)
:noquery async-process-noquery-on-exit))))
(set-process-sentinel
(get-buffer-process buf-err)
(lambda (proc _change)
@@ -418,9 +450,12 @@ working directory."
(set (make-local-variable 'async-read-marker)
(set-marker (make-marker) (point-min) buf))
(set-marker-insertion-type async-read-marker nil)
(set-process-sentinel proc #'async-when-done)
(set-process-filter proc #'async-read-from-client)
;; Pass the value of `async-prompt-for-password' to the process
;; filter fn through the lexical local var prt-for-pwd (Issue#182).
(set-process-filter proc (lambda (proc string)
(async-read-from-client
proc string prt-for-pwd)))
(unless (string= name "emacs")
(set (make-local-variable 'async-callback-for-process) t))
proc)))
@@ -431,11 +466,20 @@ Can be one of \"-Q\" or \"-q\".
Default is \"-Q\" but it is sometimes useful to use \"-q\" to have a
enhanced config or some more variables loaded.")
(defvar async-library nil
"Cache async library path.
It is useful only when you run multiple async processes in a loop, to
avoid calling many times `locate-library' which is costly.
This variable should be let bound around an `async-start' call and not
used globally. Should be found with `locate-library'.")
(defun async--emacs-program-args (&optional sexp)
"Return a list of arguments for invoking the child Emacs."
;; Using `locate-library' ensure we use the right file
;; when the .elc have been deleted.
(let ((args (list async-quiet-switch "-l" (locate-library "async"))))
;; when the .elc have been deleted, its result can be cached in
;; `async-library' see Issue#193.
(let ((args (list async-quiet-switch "-l" (or async-library
(locate-library "async")))))
(when async-child-init
(setq args (append args (list "-l" async-child-init))))
(append args (list "-batch" "-f" "async-batch-invoke"

46
lisp/async/dired-async.el
View File

@@ -81,6 +81,10 @@ or rename for `dired-async-skip-fast'."
:risky t
:type 'integer)
(defcustom dired-async-large-file-warning-threshold large-file-warning-threshold
"Same as `large-file-warning-threshold' but for dired-async."
:type 'integer)
(defface dired-async-message
'((t (:foreground "yellow")))
"Face used for mode-line message.")
@@ -115,9 +119,9 @@ or rename for `dired-async-skip-fast'."
(sit-for 3)
(force-mode-line-update)))
(defun dired-async-processes ()
(defun dired-async-processes (&optional propname)
(cl-loop for p in (process-list)
when (process-get p 'dired-async-process)
when (process-get p (or propname 'dired-async-process))
collect p))
(defun dired-async-kill-process ()
@@ -242,6 +246,14 @@ cases if `dired-async-skip-fast' is non-nil."
(funcall old-func file-creator operation
(nreverse quick-list) name-constructor marker-char))))
(defun dired-async--abort-if-file-too-large (size op-type filename)
"Warn when FILENAME larger than `dired-async-large-file-warning-threshold'.
Same as `abort-if-file-too-large' but without user-error."
(when (and dired-async-large-file-warning-threshold size
(> size dired-async-large-file-warning-threshold))
(files--ask-user-about-large-file
size op-type filename nil)))
(defvar overwrite-query)
(defun dired-async-create-files (file-creator operation fn-list name-constructor
&optional _marker-char)
@@ -299,14 +311,22 @@ ESC or `q' to not overwrite any of the remaining files,
(file-in-directory-p destname from)
(error "Cannot copy `%s' into its subdirectory `%s'"
from to)))
(if overwrite
(or (and dired-overwrite-confirmed
(push (cons from to) async-fn-list))
(progn
(push (dired-make-relative from) failures)
(dired-log "%s `%s' to `%s' failed\n"
operation from to)))
(push (cons from to) async-fn-list)))))
;; Skip file if it is too large.
(if (and (member operation '("Copy" "Rename"))
(eq (dired-async--abort-if-file-too-large
(file-attribute-size
(file-attributes (file-truename from)))
(downcase operation) from)
'abort))
(push from skipped)
(if overwrite
(or (and dired-overwrite-confirmed
(push (cons from to) async-fn-list))
(progn
(push (dired-make-relative from) failures)
(dired-log "%s `%s' to `%s' failed\n"
operation from to)))
(push (cons from to) async-fn-list))))))
;; Fix tramp issue #80 with emacs-26, use "-q" only when needed.
(setq async-quiet-switch
(if (and (boundp 'tramp-cache-read-persistent-data)
@@ -361,10 +381,14 @@ ESC or `q' to not overwrite any of the remaining files,
(async-start `(lambda ()
(require 'cl-lib) (require 'dired-aux) (require 'dired-x)
,(async-inject-variables dired-async-env-variables-regexp)
(advice-add #'files--ask-user-about-large-file
:override (lambda (&rest args) nil))
(let ((dired-recursive-copies (quote always))
(dired-copy-preserve-time
,dired-copy-preserve-time)
(dired-create-destination-dirs ',create-dir))
(dired-create-destination-dirs ',create-dir)
(dired-vc-rename-file ,dired-vc-rename-file)
auth-source-save-behavior)
(setq overwrite-backup-query nil)
;; Inline `backup-file' as long as it is not
;; available in emacs.