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
2022-01-03 19:33:12 +01:00
parent 2cf0e62418
commit a3155953d6
18 changed files with 943 additions and 717 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -1,6 +1,6 @@
;;; async-bytecomp.el --- Compile elisp files asynchronously -*- lexical-binding: t -*-
;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
;; Copyright (C) 2014-2019 Free Software Foundation, Inc.
;; Authors: John Wiegley <jwiegley@gmail.com>
;; Thierry Volpiatto <thierry.volpiatto@gmail.com>
@@ -41,6 +41,9 @@
(require 'cl-lib)
(require 'async)
(declare-function package-desc-name "package.el")
(declare-function package-desc-dir "package.el")
(defcustom async-bytecomp-allowed-packages 'all
"Packages in this list will be compiled asynchronously by `package--compile'.
All the dependencies of these packages will be compiled async too,
@@ -91,7 +94,7 @@ All *.elc files are systematically deleted before proceeding."
(async-start
`(lambda ()
(require 'bytecomp)
,(async-inject-variables "\\`\\(load-path\\)\\|byte\\'")
,(async-inject-variables "\\`\\(?:load-path\\'\\|byte-\\)")
(let ((default-directory (file-name-as-directory ,directory))
error-data)
(add-to-list 'load-path default-directory)
@@ -128,13 +131,15 @@ All *.elc files are systematically deleted before proceeding."
pkgs)))))))
seen))
(defadvice package--compile (around byte-compile-async)
(defun async--package-compile (orig-fun pkg-desc &rest args)
(let ((cur-package (package-desc-name pkg-desc))
(pkg-dir (package-desc-dir pkg-desc)))
(if (or (member async-bytecomp-allowed-packages '(t all (all)))
(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
@@ -145,7 +150,7 @@ All *.elc files are systematically deleted before proceeding."
;; `async-byte-recompile-directory' will add directory
;; as needed to `load-path'.
(async-byte-recompile-directory (package-desc-dir pkg-desc) t))
ad-do-it)))
(apply orig-fun pkg-desc args))))
;;;###autoload
(define-minor-mode async-bytecomp-package-mode
@@ -155,8 +160,8 @@ Async compilation of packages can be controlled by
:group 'async
:global t
(if async-bytecomp-package-mode
(ad-activate 'package--compile)
(ad-deactivate 'package--compile)))
(advice-add 'package--compile :around #'async--package-compile)
(advice-remove 'package--compile #'async--package-compile)))
;;;###autoload
(defun async-byte-compile-file (file)

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

@@ -1,11 +1,11 @@
(define-package "async" "20200809.501" "Asynchronous processing in Emacs"
'((emacs "24.3"))
:commit "14f48de586b0977e3470f053b810d77b07ea427a" :authors
(define-package "async" "20210823.528" "Asynchronous processing in Emacs"
'((emacs "24.4"))
:commit "fd7a9fca4a7bd0690e2e7e209397f493194e4f12" :authors
'(("John Wiegley" . "jwiegley@gmail.com"))
:maintainer
'("John Wiegley" . "jwiegley@gmail.com")
:keywords
'("convenience" "async")
'("async")
:url "https://github.com/jwiegley/emacs-async")
;; Local Variables:
;; no-byte-compile: t

60
lisp/async/async.el
View File

@@ -1,13 +1,14 @@
;;; async.el --- Asynchronous processing -*- lexical-binding: t -*-
;;; async.el --- Asynchronous processing in Emacs -*- lexical-binding: t -*-
;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
;; Copyright (C) 2012-2019 Free Software Foundation, Inc.
;; Author: John Wiegley <jwiegley@gmail.com>
;; Created: 18 Jun 2012
;; Version: 1.9.4
;; Package-Requires: ((emacs "24.3"))
;; Keywords: convenience async
;; URL: https://github.com/jwiegley/emacs-async
;; Version: 1.9.5
;; Package-Requires: ((emacs "24.4"))
;; Keywords: async
;; 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
@@ -39,7 +40,6 @@
(defcustom async-variables-noprops-function #'async--purecopy
"Default function to remove text properties in variables."
:group 'async
:type 'function)
(defvar async-debug nil)
@@ -100,14 +100,14 @@ variable's value with `async-variables-noprops-function'.
It is intended to be used as follows:
(async-start
`(lambda ()
(require 'smtpmail)
\\=`(lambda ()
(require \\='smtpmail)
(with-temp-buffer
(insert ,(buffer-substring-no-properties (point-min) (point-max)))
;; Pass in the variable environment for smtpmail
,(async-inject-variables \"\\`\\(smtpmail\\|\\(user-\\)?mail\\)-\")
,(async-inject-variables \"\\\\=`\\(smtpmail\\|\\(user-\\)?mail\\)-\")
(smtpmail-send-it)))
'ignore)"
\\='ignore)"
`(setq
,@(let (bindings)
(mapatoms
@@ -164,6 +164,19 @@ It is intended to be used as follows:
(kill-buffer (current-buffer))))
(set (make-local-variable 'async-callback-value) proc)
(set (make-local-variable 'async-callback-value-set) t))
;; Maybe strip out unreadable "#"; They are replaced by
;; empty string unless they are prefixing a special
;; object like a marker. See issue #145.
(goto-char (point-min))
(save-excursion
;; Transform markers in list like
;; (marker (moves after insertion) at 2338 in
;; test\.org) so that remap text properties function
;; can parse it to restitute marker.
(while (re-search-forward "#<\\([^>]*\\)>" nil t)
(replace-match (concat "(" (match-string 1) ")") t t)))
(while (re-search-forward "#(" nil t)
(replace-match "(" t t))
(goto-char (point-max))
(backward-sexp)
(async-handle-result async-callback (read (current-buffer))
@@ -175,8 +188,11 @@ It is intended to be used as follows:
(set (make-local-variable 'async-callback-value-set) t))))))
(defun async--receive-sexp (&optional stream)
(let ((sexp (decode-coding-string (base64-decode-string
(read stream)) 'utf-8-auto))
;; FIXME: Why use `utf-8-auto' instead of `utf-8-unix'? This is
;; a communication channel over which we have complete control,
;; so we get to choose exactly which encoding and EOL we use, isn't it?
(let ((sexp (decode-coding-string (base64-decode-string (read stream))
'utf-8-auto))
;; Parent expects UTF-8 encoded text.
(coding-system-for-write 'utf-8-auto))
(if async-debug
@@ -184,7 +200,7 @@ It is intended to be used as follows:
(setq sexp (read sexp))
(if async-debug
(message "Read sexp {{{%s}}}" (pp-to-string sexp)))
(eval sexp)))
(eval sexp t)))
(defun async--insert-sexp (sexp)
(let (print-level
@@ -226,8 +242,7 @@ It is intended to be used as follows:
(defun async-ready (future)
"Query a FUTURE to see if it is ready.
I.e., if no blocking
would result from a call to `async-get' on that FUTURE."
I.e., if no blocking would result from a call to `async-get' on that FUTURE."
(and (memq (process-status future) '(exit signal))
(let ((buf (process-buffer future)))
(if (buffer-live-p buf)
@@ -333,7 +348,18 @@ will leave *emacs* process buffers hanging around):
(async-start
(lambda ()
(delete-file \"a remote file on a slow link\" nil))
'ignore)
\\='ignore)
Special case:
If the output of START-FUNC is a string with properties
e.g. (buffer-string) RESULT will be transformed in a list where the
car is the string itself (without props) and the cdr the rest of
properties, this allows using in FINISH-FUNC the string without
properties and then apply the properties in cdr to this string (if
needed).
Properties handling special objects like markers are returned as
list to allow restoring them later.
See <https://github.com/jwiegley/emacs-async/issues/145> for more infos.
Note: Even when FINISH-FUNC is present, a future is still
returned except that it yields no value (since the value is

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

@@ -1,6 +1,6 @@
;;; dired-async.el --- Asynchronous dired actions -*- lexical-binding: t -*-
;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
;; Copyright (C) 2012-2019 Free Software Foundation, Inc.
;; Authors: John Wiegley <jwiegley@gmail.com>
;; Thierry Volpiatto <thierry.volpiatto@gmail.com>
@@ -52,46 +52,38 @@
(defcustom dired-async-env-variables-regexp
"\\`\\(tramp-\\(default\\|connection\\|remote\\)\\|ange-ftp\\)-.*"
"Variables matching this regexp will be loaded on Child Emacs."
:type 'regexp
:group 'dired-async)
:type 'regexp)
(defcustom dired-async-message-function 'dired-async-mode-line-message
"Function to use to notify result when operation finish.
Should take same args as `message'."
:group 'dired-async
:type 'function)
(defcustom dired-async-log-file "/tmp/dired-async.log"
"File use to communicate errors from Child Emacs to host Emacs."
:group 'dired-async
:type 'string)
(defcustom dired-async-mode-lighter '(:eval
(when (eq major-mode 'dired-mode)
" Async"))
"Mode line lighter used for `dired-async-mode'."
:group 'dired-async
:risky t
:type 'sexp)
(defface dired-async-message
'((t (:foreground "yellow")))
"Face used for mode-line message."
:group 'dired-async)
'((t (:foreground "yellow")))
"Face used for mode-line message.")
(defface dired-async-failures
'((t (:foreground "red")))
"Face used for mode-line message."
:group 'dired-async)
'((t (:foreground "red")))
"Face used for mode-line message.")
(defface dired-async-mode-message
'((t (:foreground "Gold")))
"Face used for `dired-async--modeline-mode' lighter."
:group 'dired-async)
'((t (:foreground "Gold")))
"Face used for `dired-async--modeline-mode' lighter.")
(define-minor-mode dired-async--modeline-mode
"Notify mode-line that an async process run."
:group 'dired-async
"Notify mode-line that an async process run."
:global t
:lighter (:eval (propertize (format " [%s Async job(s) running]"
(length (dired-async-processes)))
@@ -321,8 +313,8 @@ ESC or `q' to not overwrite any of the remaining files,
do (condition-case err
(funcall fn from dest t)
(file-error
(dired-log "%s: %s\n" (car err) (cdr err)))
nil))
(dired-log "%s: %s\n" (car err) (cdr err))
nil)))
(when (get-buffer dired-log-buffer)
(dired-log t)
(with-current-buffer dired-log-buffer
@@ -343,31 +335,18 @@ ESC or `q' to not overwrite any of the remaining files,
(let (wdired-use-interactive-rename)
(apply old-fn args)))
(defadvice wdired-do-renames (around wdired-async)
(let (wdired-use-interactive-rename)
ad-do-it))
(defadvice dired-create-files (around dired-async)
(dired-async-create-files file-creator operation fn-list
name-constructor marker-char))
;;;###autoload
(define-minor-mode dired-async-mode
"Do dired actions asynchronously."
:group 'dired-async
:lighter dired-async-mode-lighter
:global t
(if dired-async-mode
(if (fboundp 'advice-add)
(progn (advice-add 'dired-create-files :override #'dired-async-create-files)
(advice-add 'wdired-do-renames :around #'dired-async-wdired-do-renames))
(ad-activate 'dired-create-files)
(ad-activate 'wdired-do-renames))
(if (fboundp 'advice-remove)
(progn (advice-remove 'dired-create-files #'dired-async-create-files)
(advice-remove 'wdired-do-renames #'dired-async-wdired-do-renames))
(ad-deactivate 'dired-create-files)
(ad-deactivate 'wdired-do-renames))))
(progn
(advice-add 'dired-create-files :override #'dired-async-create-files)
(advice-add 'wdired-do-renames :around #'dired-async-wdired-do-renames))
(progn
(advice-remove 'dired-create-files #'dired-async-create-files)
(advice-remove 'wdired-do-renames #'dired-async-wdired-do-renames))))
(defmacro dired-async--with-async-create-files (&rest body)
"Evaluate BODY with ‘dired-create-files’ set to ‘dired-async-create-files’."