branch: externals/async commit a4a50337e4c3691be3097221b586511793bde7df Author: Stefan Monnier <monn...@iro.umontreal.ca> Commit: Stefan Monnier <monn...@iro.umontreal.ca>
Use cl-lib an nadvice (re-apply 783af291680d) * async-bytecomp.el: (async--package-compile): New function, extracted from the old defadvice. (package-compile): Remove defadvice. (async-bytecomp-package-mode): Advise/Unadvise package--compile. * packages/async/async-test.el: Don't needlessly require `cl`. Use lexical-binding. * packages/async/async.el: Require cl-lib and nadvice. (async--receive-sexp): Consistently use lexical-binding. * dired-async.el: Remove redundant `:group`s. (wdired-do-renames, dired-create-files): Remove defadvice. (dired-async-mode): `advice-add/remove` is always available. --- async-bytecomp.el | 12 +++++++----- async-test.el | 11 ++--------- async.el | 26 ++++++++++++++------------ dired-async.el | 43 +++++++++++-------------------------------- 4 files changed, 34 insertions(+), 58 deletions(-) diff --git a/async-bytecomp.el b/async-bytecomp.el index d2243b8..72b141c 100644 --- a/async-bytecomp.el +++ b/async-bytecomp.el @@ -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 <jwieg...@gmail.com> ;; Thierry Volpiatto <thierry.volpia...@gmail.com> @@ -134,13 +134,15 @@ All *.elc files are systematically deleted before proceeding." (setq pkgs (append (package-desc-reqs pkg-desc) 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 @@ -151,7 +153,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 @@ -161,8 +163,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) diff --git a/async-test.el b/async-test.el index 76d6a3a..5387aa0 100644 --- a/async-test.el +++ b/async-test.el @@ -1,6 +1,6 @@ -;;; async-test.el --- async.el-related tests +;;; async-test.el --- async.el-related tests -*- lexical-binding:t -*- -;; Copyright (C) 2012-2016 Free Software Foundation, Inc. +;; Copyright (C) 2012-2019 Free Software Foundation, Inc. ;; Author: John Wiegley <jwieg...@gmail.com> ;; Created: 10 Jul 2012 @@ -32,9 +32,6 @@ (require 'async) -(eval-when-compile - (require 'cl)) - (defun async-test-1 () (interactive) (message "Starting async-test-1...") @@ -134,7 +131,3 @@ (provide 'async-test) ;;; async-test.el ends here - -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/async.el b/async.el index d616b11..61450ef 100644 --- a/async.el +++ b/async.el @@ -1,10 +1,11 @@ ;;; 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 <jwieg...@gmail.com> ;; Created: 18 Jun 2012 ;; Version: 1.9.3 +;; Package-Requires: ((cl-lib "0.5") (nadvice "0.3")) ;; Keywords: async ;; X-URL: https://github.com/jwiegley/emacs-async @@ -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 @@ -175,8 +175,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 +187,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 +229,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 +335,7 @@ will leave *emacs* process buffers hanging around): (async-start (lambda () (delete-file \"a remote file on a slow link\" nil)) - 'ignore) + \\='ignore) Note: Even when FINISH-FUNC is present, a future is still returned except that it yields no value (since the value is diff --git a/dired-async.el b/dired-async.el index 677c169..56bafd5 100644 --- a/dired-async.el +++ b/dired-async.el @@ -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 <jwieg...@gmail.com> ;; Thierry Volpiatto <thierry.volpia...@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) + "Face used for mode-line message.") (defface dired-async-failures '((t (:foreground "red"))) - "Face used for mode-line message." - :group 'dired-async) + "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) + "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 :global t :lighter (:eval (propertize (format " [%s Async job(s) running]" (length (dired-async-processes))) @@ -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’."