[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master c5a0196: * async: Make it an external
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] master c5a0196: * async: Make it an external |
|
Date: |
Tue, 8 Oct 2019 10:42:10 -0400 (EDT) |
branch: master
commit c5a019683739b7047957857b886a1ab920cad192
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>
* async: Make it an external
---
.gitignore | 2 +
externals-list | 1 +
packages/async/Makefile | 74 ---------
packages/async/async-bytecomp.el | 179 --------------------
packages/async/async-test.el | 133 ---------------
packages/async/async.el | 349 ---------------------------------------
packages/async/dired-async.el | 317 -----------------------------------
packages/async/smtpmail-async.el | 73 --------
8 files changed, 3 insertions(+), 1125 deletions(-)
diff --git a/.gitignore b/.gitignore
index 69d8f20..be5cc5c 100644
--- a/.gitignore
+++ b/.gitignore
@@ -10,6 +10,7 @@ packages/*/*-autoloads.el
packages/*/*-pkg.el
# External packages with their own .git tree [autogenerated].
+packages/async/
packages/auctex/
packages/bbdb/
packages/bnf-mode/
@@ -69,6 +70,7 @@ packages/tramp/
packages/verilog-mode/
packages/w3/
packages/webfeeder/
+packages/wisitoken-grammar-mode/
packages/xelb/
packages/xr/
packages/zones/
diff --git a/externals-list b/externals-list
index 638e2e5..74e73c1 100644
--- a/externals-list
+++ b/externals-list
@@ -32,6 +32,7 @@
(("ack" :subtree "https://github.com/leoliu/ack-el";)
("aggressive-indent" :subtree
"https://github.com/Malabarba/aggressive-indent-mode";)
+ ("async" :external "https://github.com/jwiegley/emacs-async";)
("auctex" :external "git://git.sv.gnu.org/auctex.git")
("bbdb" :external "git://git.savannah.nongnu.org/bbdb.git")
("bnf-mode" :external "https://github.com/sergeyklay/bnf-mode";)
diff --git a/packages/async/Makefile b/packages/async/Makefile
deleted file mode 100644
index d39d657..0000000
--- a/packages/async/Makefile
+++ /dev/null
@@ -1,74 +0,0 @@
-# makefile for async.
-
-# Author: Thierry Volpiatto.
-# Copyright (C) 2011~2017, Thierry Volpiatto, all rights reserved.
-
-## This file is NOT part of GNU Emacs
-##
-## License
-##
-## 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, 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; see the file COPYING. If not, write to
-## the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-## Floor, Boston, MA 02110-1301, USA.
-
-# Emacs invocation
-EMACS_COMMAND := emacs
-
-EMACS := $(EMACS_COMMAND) -Q -batch
-
-EVAL := $(EMACS) --eval
-
-PKGDIR := .
-
-# Additional emacs loadpath
-LOADPATH := -L .
-
-# Files to compile
-EL := $(sort $(wildcard *async*.el))
-
-# Compiled files
-ELC := $(EL:.el=.elc)
-
-
-.PHONY: clean autoloads batch-compile install uninstall
-
-all: clean autoloads batch-compile
-
-$(ELC): %.elc: %.el
- $(EMACS) $(LOADPATH) -f batch-byte-compile $<
-
-# Compile needed files
-compile: $(ELC)
-
-# Compile all files at once
-batch-compile:
- $(EMACS) $(LOADPATH) -f batch-byte-compile $(EL)
-
-# Remove all generated files
-clean:
- rm -f $(ELC)
-
-# Make autoloads file
-autoloads:
- $(EVAL) "(let ((generated-autoload-file (expand-file-name
\"async-autoloads.el\" \"$(PKGDIR)\")) \
-(backup-inhibited t)) (update-directory-autoloads \"$(PKGDIR)\"))"
-
-PREFIX=/usr/local/share/
-DESTDIR=${PREFIX}emacs/site-lisp/emacs-async/
-install:
- test -d ${DESTDIR} || mkdir ${DESTDIR}
- cp -vf *.elc $(DESTDIR)
-
-uninstall:
- rm -vf ${DESTDIR}*.elc
diff --git a/packages/async/async-bytecomp.el b/packages/async/async-bytecomp.el
deleted file mode 100644
index 082b31a..0000000
--- a/packages/async/async-bytecomp.el
+++ /dev/null
@@ -1,179 +0,0 @@
-;;; async-bytecomp.el --- Compile elisp files asynchronously -*-
lexical-binding: t -*-
-
-;; Copyright (C) 2014-2019 Free Software Foundation, Inc.
-
-;; Authors: John Wiegley <address@hidden>
-;; Thierry Volpiatto <address@hidden>
-
-;; Keywords: dired async byte-compile
-;; X-URL: https://github.com/jwiegley/dired-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 2, 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 GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; 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.
-;;
-;; NB: This package is advicing the function `package--compile'.
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'async)
-
-(defcustom async-bytecomp-allowed-packages
- '(async helm helm-core helm-ls-git helm-ls-hg magit)
- "Packages in this list will be compiled asynchronously by `package--compile'.
-All the dependencies of these packages will be compiled async too,
-so no need to add dependencies to this list.
-The value of this variable can also be a list with a single element,
-the symbol `all', in this case packages are always compiled asynchronously."
- :group 'async
- :type '(repeat (choice symbol)))
-
-(defvar async-byte-compile-log-file (expand-file-name "async-bytecomp.log"
user-emacs-directory))
-
-;;;###autoload
-(defun async-byte-recompile-directory (directory &optional quiet)
- "Compile all *.el files in DIRECTORY asynchronously.
-All *.elc files are systematically deleted before proceeding."
- (cl-loop with dir = (directory-files directory t "\\.elc\\'")
- unless dir return nil
- for f in dir
- when (file-exists-p f) do (delete-file f))
- ;; Ensure async is reloaded when async.elc is deleted.
- ;; This happen when recompiling its own directory.
- (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-start
- `(lambda ()
- (require 'bytecomp)
- ,(async-inject-variables "\\`\\(load-path\\)\\|byte\\'")
- (let ((default-directory (file-name-as-directory ,directory))
- error-data)
- (add-to-list 'load-path default-directory)
- (byte-recompile-directory ,directory 0 t)
- (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))))))
- call-back)
- (unless quiet (message "Started compiling asynchronously directory %s"
directory))))
-
-(defvar package-archive-contents)
-(defvar package-alist)
-(declare-function package-desc-reqs "package.el" (cl-x))
-
-(defun async-bytecomp--get-package-deps (pkg &optional only)
- ;; Same as `package--get-deps' but parse instead `package-archive-contents'
- ;; because PKG is not already installed and not present in `package-alist'.
- ;; However fallback to `package-alist' in case PKG no more present
- ;; in `package-archive-contents' due to modification to `package-archives'.
- ;; See issue #58.
- (let* ((pkg-desc (cadr (or (assq pkg package-archive-contents)
- (assq pkg package-alist))))
- (direct-deps (cl-loop for p in (package-desc-reqs pkg-desc)
- for name = (car p)
- when (or (assq name package-archive-contents)
- (assq name package-alist))
- collect name))
- (indirect-deps (unless (eq only 'direct)
- (delete-dups
- (cl-loop for p in direct-deps append
- (async-bytecomp--get-package-deps p))))))
- (cl-case only
- (direct direct-deps)
- (separate (list direct-deps indirect-deps))
- (indirect indirect-deps)
- (t (delete-dups (append direct-deps indirect-deps))))))
-
-(defun async-bytecomp-get-allowed-pkgs ()
- (when (and async-bytecomp-allowed-packages
- (listp async-bytecomp-allowed-packages))
- (if package-archive-contents
- (cl-loop for p in async-bytecomp-allowed-packages
- when (assq p package-archive-contents)
- append (async-bytecomp--get-package-deps p) into reqs
- finally return
- (delete-dups
- (append async-bytecomp-allowed-packages reqs)))
- async-bytecomp-allowed-packages)))
-
-(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 (equal async-bytecomp-allowed-packages '(all))
- (memq cur-package (async-bytecomp-get-allowed-pkgs)))
- (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")
- (cl-pushnew pkg-dir load-path)
- (load "async-bytecomp"))
- ;; `async-byte-recompile-directory' will add directory
- ;; as needed to `load-path'.
- (async-byte-recompile-directory (package-desc-dir pkg-desc) t))
- (apply orig-fun pkg-desc args))))
-
-;;;###autoload
-(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'."
- :group 'async
- :global t
- (if async-bytecomp-package-mode
- (advice-add 'package--compile :around #'async--package-compile)
- (advice-remove 'package--compile #'async--package-compile)))
-
-(provide 'async-bytecomp)
-
-;;; async-bytecomp.el ends here
diff --git a/packages/async/async-test.el b/packages/async/async-test.el
deleted file mode 100644
index 5387aa0..0000000
--- a/packages/async/async-test.el
+++ /dev/null
@@ -1,133 +0,0 @@
-;;; async-test.el --- async.el-related tests -*- lexical-binding:t -*-
-
-;; Copyright (C) 2012-2019 Free Software Foundation, Inc.
-
-;; Author: John Wiegley <address@hidden>
-;; Created: 10 Jul 2012
-;; Version: 1.0
-;; 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
-;; published by the Free Software Foundation; either version 2, 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 GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Contains tests for all the async modules.
-
-;;; Code:
-
-(require 'async)
-
-
-(defun async-test-1 ()
- (interactive)
- (message "Starting async-test-1...")
- (async-start
- ;; What to do in the child process
- (lambda ()
- (message "This is a test")
- (sleep-for 3)
- 222)
-
- ;; What to do when it finishes
- (lambda (result)
- (message "Async process done, result should be 222: %s" result)))
- (message "Starting async-test-1...done"))
-
-(defun async-test-2 ()
- (interactive)
- (message "Starting async-test-2...")
- (let ((proc (async-start
- ;; What to do in the child process
- (lambda ()
- (message "This is a test")
- (sleep-for 3)
- 222))))
- (message "I'm going to do some work here")
- ;; ....
- (message "Async process done, result should be 222: %s"
- (async-get proc))))
-
-(defun async-test-3 ()
- (interactive)
- (message "Starting async-test-3...")
- (async-start
- ;; What to do in the child process
- (lambda ()
- (message "This is a test")
- (sleep-for 3)
- (error "Error in child process")
- 222)
-
- ;; What to do when it finishes
- (lambda (result)
- (message "Async process done, result should be 222: %s" result)))
- (message "Starting async-test-1...done"))
-
-(defun async-test-4 ()
- (interactive)
- (message "Starting async-test-4...")
- (async-start-process "sleep" "sleep"
- ;; What to do when it finishes
- (lambda (proc)
- (message "Sleep done, exit code was %d"
- (process-exit-status proc)))
- "3")
- (message "Starting async-test-4...done"))
-
-(defun async-test-5 ()
- (interactive)
- (message "Starting async-test-5...")
- (let ((proc
- (async-start
- ;; What to do in the child process
- (lambda ()
- (message "This is a test, sending message")
- (async-send :hello "world")
- ;; wait for a message
- (let ((msg (async-receive)))
- (message "Child got message: %s"
- (plist-get msg :goodbye)))
- (sleep-for 3)
- 222)
-
- ;; What to do when it finishes
- (lambda (result)
- (if (async-message-p result)
- (message "Got hello from child process: %s"
- (plist-get result :hello))
- (message "Async process done, result should be 222: %s"
- result))))))
- (async-send proc :goodbye "everyone"))
- (message "Starting async-test-5...done"))
-
-(defun async-test-6 ()
- (interactive)
- (message "Starting async-test-6...")
- (async-start
- ;; What to do in the child process
- `(lambda ()
- ,(async-inject-variables "\\`user-mail-address\\'")
- (format "user-mail-address = %s" user-mail-address))
-
- ;; What to do when it finishes
- (lambda (result)
- (message "Async process done: %s" result))))
-
-
-(provide 'async-test)
-
-;;; async-test.el ends here
diff --git a/packages/async/async.el b/packages/async/async.el
deleted file mode 100644
index ce651de..0000000
--- a/packages/async/async.el
+++ /dev/null
@@ -1,349 +0,0 @@
-;;; async.el --- Asynchronous processing in Emacs -*- lexical-binding: t -*-
-
-;; Copyright (C) 2012-2019 Free Software Foundation, Inc.
-
-;; Author: John Wiegley <address@hidden>
-;; Created: 18 Jun 2012
-;; Version: 1.9.2
-;; Package-Requires: ((cl-lib "0.5") (nadvice "0.3"))
-
-;; 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
-;; published by the Free Software Foundation; either version 2, 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 GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Adds the ability to call asynchronous functions and process with ease. See
-;; the documentation for `async-start' and `async-start-process'.
-
-;;; Code:
-
-(defgroup async nil
- "Simple asynchronous processing in Emacs"
- :group 'emacs)
-
-(defvar async-debug nil)
-(defvar async-send-over-pipe t)
-(defvar async-in-child-emacs nil)
-(defvar async-callback nil)
-(defvar async-callback-for-process nil)
-(defvar async-callback-value nil)
-(defvar async-callback-value-set nil)
-(defvar async-current-process nil)
-(defvar async--procvar nil)
-
-(defun async-inject-variables
- (include-regexp &optional predicate exclude-regexp)
- "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). It is intended to be used
-as follows:
-
- (async-start
- \\=`(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\\)-\")
- (smtpmail-send-it)))
- \\='ignore)"
- `(setq
- ,@(let (bindings)
- (mapatoms
- (lambda (sym)
- (if (and (boundp sym)
- (or (null include-regexp)
- (string-match include-regexp (symbol-name sym)))
- (not (string-match
- (or exclude-regexp "-syntax-table\\'")
- (symbol-name sym))))
- (let ((value (symbol-value sym)))
- (when (or (null predicate)
- (funcall predicate sym))
- (setq bindings (cons `(quote ,value) bindings)
- bindings (cons sym bindings)))))))
- bindings)))
-
-(defalias 'async-inject-environment 'async-inject-variables)
-
-(defun async-handle-result (func result buf)
- (if (null func)
- (progn
- (set (make-local-variable 'async-callback-value) result)
- (set (make-local-variable 'async-callback-value-set) t))
- (unwind-protect
- (if (and (listp result)
- (eq 'async-signal (nth 0 result)))
- (signal (car (nth 1 result))
- (cdr (nth 1 result)))
- (funcall func result))
- (unless async-debug
- (kill-buffer buf)))))
-
-(defun async-when-done (proc &optional _change)
- "Process sentinel used to retrieve the value from the child process."
- (when (eq 'exit (process-status proc))
- (with-current-buffer (process-buffer proc)
- (let ((async-current-process proc))
- (if (= 0 (process-exit-status proc))
- (if async-callback-for-process
- (if async-callback
- (prog1
- (funcall async-callback proc)
- (unless async-debug
- (kill-buffer (current-buffer))))
- (set (make-local-variable 'async-callback-value) proc)
- (set (make-local-variable 'async-callback-value-set) t))
- (goto-char (point-max))
- (backward-sexp)
- (async-handle-result async-callback (read (current-buffer))
- (current-buffer)))
- (set (make-local-variable 'async-callback-value)
- (list 'error
- (format "Async process '%s' failed with exit code %d"
- (process-name proc) (process-exit-status proc))))
- (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-unix))
- ;; Parent expects UTF-8 encoded text.
- (coding-system-for-write 'utf-8-unix))
- (if async-debug
- (message "Received sexp {{{%s}}}" (pp-to-string sexp)))
- (setq sexp (read sexp))
- (if async-debug
- (message "Read sexp {{{%s}}}" (pp-to-string sexp)))
- (eval sexp t)))
-
-(defun async--insert-sexp (sexp)
- (let (print-level
- print-length
- (print-escape-nonascii t)
- (print-circle t))
- (prin1 sexp (current-buffer))
- ;; Just in case the string we're sending might contain EOF
- (encode-coding-region (point-min) (point-max) 'utf-8-unix)
- (base64-encode-region (point-min) (point-max) t)
- (goto-char (point-min)) (insert ?\")
- (goto-char (point-max)) (insert ?\" ?\n)))
-
-(defun async--transmit-sexp (process sexp)
- (with-temp-buffer
- (if async-debug
- (message "Transmitting sexp {{{%s}}}" (pp-to-string sexp)))
- (async--insert-sexp sexp)
- (process-send-region process (point-min) (point-max))))
-
-(defun async-batch-invoke ()
- "Called from the child Emacs process' command-line."
- ;; Make sure 'message' and 'prin1' encode stuff in UTF-8, as parent
- ;; process expects.
- (let ((coding-system-for-write 'utf-8-unix))
- (setq async-in-child-emacs t
- debug-on-error async-debug)
- (if debug-on-error
- (prin1 (funcall
- (async--receive-sexp (unless async-send-over-pipe
- command-line-args-left))))
- (condition-case err
- (prin1 (funcall
- (async--receive-sexp (unless async-send-over-pipe
- command-line-args-left))))
- (error
- (prin1 (list 'async-signal err)))))))
-
-(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."
- (and (memq (process-status future) '(exit signal))
- (let ((buf (process-buffer future)))
- (if (buffer-live-p buf)
- (with-current-buffer buf
- async-callback-value-set)
- t))))
-
-(defun async-wait (future)
- "Wait for FUTURE to become ready."
- (while (not (async-ready future))
- (sleep-for 0.05)))
-
-(defun async-get (future)
- "Get the value from process FUTURE when it is ready.
-FUTURE is returned by `async-start' or `async-start-process' when
-its FINISH-FUNC is nil."
- (and future (async-wait future))
- (let ((buf (process-buffer future)))
- (when (buffer-live-p buf)
- (with-current-buffer buf
- (async-handle-result
- #'identity async-callback-value (current-buffer))))))
-
-(defun async-message-p (value)
- "Return true of VALUE is an async.el message packet."
- (and (listp value)
- (plist-get value :async-message)))
-
-(defun async-send (&rest args)
- "Send the given messages to the asychronous Emacs PROCESS."
- (let ((args (append args '(:async-message t))))
- (if async-in-child-emacs
- (if async-callback
- (funcall async-callback args))
- (async--transmit-sexp (car args) (list 'quote (cdr args))))))
-
-(defun async-receive ()
- "Send the given messages to the asychronous Emacs PROCESS."
- (async--receive-sexp))
-
-;;;###autoload
-(defun async-start-process (name program finish-func &rest program-args)
- "Start the executable PROGRAM asynchronously. See `async-start'.
-PROGRAM is passed PROGRAM-ARGS, calling FINISH-FUNC with the
-process object when done. If FINISH-FUNC is nil, the future
-object will return the process object when the program is
-finished. Set DEFAULT-DIRECTORY to change PROGRAM's current
-working directory."
- (let* ((buf (generate-new-buffer (concat "*" name "*")))
- (proc (let ((process-connection-type nil))
- (apply #'start-process name buf program program-args))))
- (with-current-buffer buf
- (set (make-local-variable 'async-callback) finish-func)
- (set-process-sentinel proc #'async-when-done)
- (unless (string= name "emacs")
- (set (make-local-variable 'async-callback-for-process) t))
- proc)))
-
-;;;###autoload
-(defun async-start (start-func &optional finish-func)
- "Execute START-FUNC (often a lambda) in a subordinate Emacs process.
-When done, the return value is passed to FINISH-FUNC. Example:
-
- (async-start
- ;; What to do in the child process
- (lambda ()
- (message \"This is a test\")
- (sleep-for 3)
- 222)
-
- ;; What to do when it finishes
- (lambda (result)
- (message \"Async process done, result should be 222: %s\"
- result)))
-
-If FINISH-FUNC is nil or missing, a future is returned that can
-be inspected using `async-get', blocking until the value is
-ready. Example:
-
- (let ((proc (async-start
- ;; What to do in the child process
- (lambda ()
- (message \"This is a test\")
- (sleep-for 3)
- 222))))
-
- (message \"I'm going to do some work here\") ;; ....
-
- (message \"Waiting on async process, result should be 222: %s\"
- (async-get proc)))
-
-If you don't want to use a callback, and you don't care about any
-return value from the child process, pass the `ignore' symbol as
-the second argument (if you don't, and never call `async-get', it
-will leave *emacs* process buffers hanging around):
-
- (async-start
- (lambda ()
- (delete-file \"a remote file on a slow link\" nil))
- \\='ignore)
-
-Note: Even when FINISH-FUNC is present, a future is still
-returned except that it yields no value (since the value is
-passed to FINISH-FUNC). Call `async-get' on such a future always
-returns nil. It can still be useful, however, as an argument to
-`async-ready' or `async-wait'."
- (let ((sexp start-func)
- ;; Subordinate Emacs will send text encoded in UTF-8.
- (coding-system-for-read 'utf-8-unix))
- (setq async--procvar
- (async-start-process
- "emacs" (file-truename
- (expand-file-name invocation-name
- invocation-directory))
- finish-func
- "-Q" "-l"
- ;; Using `locate-library' ensure we use the right file
- ;; when the .elc have been deleted.
- (locate-library "async")
- "-batch" "-f" "async-batch-invoke"
- (if async-send-over-pipe
- "<none>"
- (with-temp-buffer
- (async--insert-sexp (list 'quote sexp))
- (buffer-string)))))
- (if async-send-over-pipe
- (async--transmit-sexp async--procvar (list 'quote sexp)))
- async--procvar))
-
-(defmacro async-sandbox(func)
- "Evaluate FUNC in a separate Emacs process, synchronously."
- `(async-get (async-start ,func)))
-
-(defun async--fold-left (fn forms bindings)
- (let ((res forms))
- (dolist (binding bindings)
- (setq res (funcall fn res
- (if (listp binding)
- binding
- (list binding)))))
- res))
-
-(defmacro async-let (bindings &rest forms)
- "Implements `let', but each binding is established asynchronously.
-For example:
-
- (async-let ((x (foo))
- (y (bar)))
- (message \"%s %s\" x y))
-
- expands to ==>
-
- (async-start (foo)
- (lambda (x)
- (async-start (bar)
- (lambda (y)
- (message \"%s %s\" x y)))))"
- (declare (indent 1))
- (async--fold-left
- (lambda (acc binding)
- (let ((fun (pcase (cadr binding)
- ((and (pred functionp) f) f)
- (f `(lambda () ,f)))))
- `(async-start ,fun
- (lambda (,(car binding))
- ,acc))))
- `(progn ,@forms)
- (reverse bindings)))
-
-(provide 'async)
-
-;;; async.el ends here
diff --git a/packages/async/dired-async.el b/packages/async/dired-async.el
deleted file mode 100644
index dd3c50f..0000000
--- a/packages/async/dired-async.el
+++ /dev/null
@@ -1,317 +0,0 @@
-;;; dired-async.el --- Asynchronous dired actions -*- lexical-binding: t -*-
-
-;; Copyright (C) 2012-2019 Free Software Foundation, Inc.
-
-;; Authors: John Wiegley <address@hidden>
-;; Thierry Volpiatto <address@hidden>
-
-;; Keywords: dired async network
-;; X-URL: https://github.com/jwiegley/dired-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 2, 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 GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This file provide a redefinition of `dired-create-file' function,
-;; performs copies, moves and all what is handled by `dired-create-file'
-;; in the background using a slave Emacs process,
-;; by means of the async.el module.
-;; To use it, put this in your .emacs:
-
-;; (dired-async-mode 1)
-
-;; This will enable async copy/rename etc...
-;; in dired and helm.
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'dired-aux)
-(require 'async)
-
-(eval-when-compile
- (defvar async-callback))
-
-(defgroup dired-async nil
- "Copy rename files asynchronously from dired."
- :group 'dired)
-
-(defcustom dired-async-env-variables-regexp
- "\\`\\(tramp-\\(default\\|connection\\|remote\\)\\|ange-ftp\\)-.*"
- "Variables matching this regexp will be loaded on Child Emacs."
- :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'."
- :type 'function)
-
-(defcustom dired-async-log-file "/tmp/dired-async.log"
- "File use to communicate errors from Child Emacs to host Emacs."
- :type 'string)
-
-(defface dired-async-message
- '((t (:foreground "yellow")))
- "Face used for mode-line message.")
-
-(defface dired-async-failures
- '((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.")
-
-(define-minor-mode dired-async--modeline-mode
- "Notify mode-line that an async process run."
- :global t
- :lighter (:eval (propertize (format " [%s Async job(s) running]"
- (length (dired-async-processes)))
- 'face 'dired-async-mode-message))
- (unless dired-async--modeline-mode
- (let ((visible-bell t)) (ding))))
-
-(defun dired-async-mode-line-message (text face &rest args)
- "Notify end of operation in `mode-line'."
- (message nil)
- (let ((mode-line-format (concat
- " " (propertize
- (if args
- (apply #'format text args)
- text)
- 'face face))))
- (force-mode-line-update)
- (sit-for 3)
- (force-mode-line-update)))
-
-(defun dired-async-processes ()
- (cl-loop for p in (process-list)
- when (cl-loop for c in (process-command p) thereis
- (string= "async-batch-invoke" c))
- collect p))
-
-(defun dired-async-kill-process ()
- (interactive)
- (let* ((processes (dired-async-processes))
- (proc (car (last processes))))
- (and proc (delete-process proc))
- (unless (> (length processes) 1)
- (dired-async--modeline-mode -1))))
-
-(defun dired-async-after-file-create (total operation failures skipped)
- "Callback function used for operation handled by `dired-create-file'."
- (unless (dired-async-processes)
- ;; Turn off mode-line notification
- ;; only when last process end.
- (dired-async--modeline-mode -1))
- (when operation
- (if (file-exists-p dired-async-log-file)
- (progn
- (pop-to-buffer (get-buffer-create dired-log-buffer))
- (goto-char (point-max))
- (setq inhibit-read-only t)
- (insert "Error: ")
- (insert-file-contents dired-async-log-file)
- (special-mode)
- (shrink-window-if-larger-than-buffer)
- (delete-file dired-async-log-file))
- (run-with-timer
- 0.1 nil
- (lambda ()
- ;; First send error messages.
- (cond (failures
- (funcall dired-async-message-function
- "%s failed for %d of %d file%s -- See *Dired log*
buffer"
- 'dired-async-failures
- (car operation) (length failures)
- total (dired-plural-s total)))
- (skipped
- (funcall dired-async-message-function
- "%s: %d of %d file%s skipped -- See *Dired log*
buffer"
- 'dired-async-failures
- (car operation) (length skipped) total
- (dired-plural-s total))))
- ;; Finally send the success message.
- (funcall dired-async-message-function
- "Asynchronous %s of %s on %s file%s done"
- 'dired-async-message
- (car operation) (cadr operation)
- total (dired-plural-s total)))))))
-
-(defun dired-async-maybe-kill-ftp ()
- "Return a form to kill ftp process in child emacs."
- (quote
- (progn
- (require 'cl-lib)
- (let ((buf (cl-loop for b in (buffer-list)
- thereis (and (string-match
- "\\`\\*ftp.*"
- (buffer-name b)) b))))
- (when buf (kill-buffer buf))))))
-
-(defvar overwrite-query)
-(defun dired-async-create-files (file-creator operation fn-list
name-constructor
- &optional _marker-char)
- "Same as `dired-create-files' but asynchronous.
-
-See `dired-create-files' for the behavior of arguments."
- (setq overwrite-query nil)
- (let ((total (length fn-list))
- failures async-fn-list skipped callback)
- (let (to)
- (dolist (from fn-list)
- (setq to (funcall name-constructor from))
- (if (equal to from)
- (progn
- (setq to nil)
- (dired-log "Cannot %s to same file: %s\n"
- (downcase operation) from)))
- (if (not to)
- (setq skipped (cons (dired-make-relative from) skipped))
- (let* ((overwrite (and (null (eq file-creator 'backup-file))
- (file-exists-p to)))
- (dired-overwrite-confirmed ; for dired-handle-overwrite
- (and overwrite
- (let ((help-form `(format "\
-Type SPC or `y' to overwrite file `%s',
-DEL or `n' to skip to next,
-ESC or `q' to not overwrite any of the remaining files,
-`!' to overwrite all remaining files with no more questions." ,to)))
- (dired-query 'overwrite-query "Overwrite `%s'?"
to)))))
- ;; Handle the `dired-copy-file' file-creator specially
- ;; When copying a directory to another directory or
- ;; possibly to itself or one of its subdirectories.
- ;; e.g "~/foo/" => "~/test/"
- ;; or "~/foo/" =>"~/foo/"
- ;; or "~/foo/ => ~/foo/bar/")
- ;; In this case the 'name-constructor' have set the destination
- ;; TO to "~/test/foo" because the old emacs23 behavior
- ;; of `copy-directory' was to not create the subdirectory
- ;; and instead copy the contents.
- ;; With the new behavior of `copy-directory'
- ;; (similar to the `cp' shell command) we don't
- ;; need such a construction of the target directory,
- ;; so modify the destination TO to "~/test/" instead of
"~/test/foo/".
- (let ((destname (file-name-directory to)))
- (when (and (file-directory-p from)
- (file-directory-p to)
- (eq file-creator 'dired-copy-file))
- (setq to destname))
- ;; If DESTNAME is a subdirectory of FROM, not a symlink,
- ;; and the method in use is copying, signal an error.
- (and (eq t (car (file-attributes destname)))
- (eq file-creator 'dired-copy-file)
- (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)))))
- ;; When failures have been printed to dired log add the date at bob.
- (when (or failures skipped) (dired-log t))
- ;; When async-fn-list is empty that's mean only one file
- ;; had to be copied and user finally answer NO.
- ;; In this case async process will never start and callback
- ;; will have no chance to run, so notify failures here.
- (unless async-fn-list
- (cond (failures
- (funcall dired-async-message-function
- "%s failed for %d of %d file%s -- See *Dired log*
buffer"
- 'dired-async-failures
- operation (length failures)
- total (dired-plural-s total)))
- (skipped
- (funcall dired-async-message-function
- "%s: %d of %d file%s skipped -- See *Dired log* buffer"
- 'dired-async-failures
- operation (length skipped) total
- (dired-plural-s total)))))
- ;; Setup callback.
- (setq callback
- (lambda (&optional _ignore)
- (dired-async-after-file-create
- total (list operation (length async-fn-list)) failures skipped)
- (when (string= (downcase operation) "rename")
- (cl-loop for (file . to) in async-fn-list
- for bf = (get-file-buffer file)
- for destp = (file-exists-p to)
- do (and bf destp
- (with-current-buffer bf
- (set-visited-file-name to t t))))))))
- ;; Start async process.
- (when async-fn-list
- (async-start `(lambda ()
- (require 'cl-lib) (require 'dired-aux) (require 'dired-x)
- ,(async-inject-variables
dired-async-env-variables-regexp)
- (let ((dired-recursive-copies (quote always))
- (dired-copy-preserve-time
- ,dired-copy-preserve-time))
- (setq overwrite-backup-query nil)
- ;; Inline `backup-file' as long as it is not
- ;; available in emacs.
- (defalias 'backup-file
- ;; Same feature as "cp --backup=numbered from
to"
- ;; Symlinks are copied as file from source
unlike
- ;; `dired-copy-file' which is same as cp -d.
- ;; Directories are omitted.
- (lambda (from to ok)
- (cond ((file-directory-p from) (ignore))
- (t (let ((count 0))
- (while (let ((attrs
(file-attributes to)))
- (and attrs (null (nth 0
attrs))))
- (cl-incf count)
- (setq to (concat
(file-name-sans-versions to)
- (format
".~%s~" count)))))
- (condition-case err
- (copy-file from to ok
dired-copy-preserve-time)
- (file-date-error
- (dired-log "Can't set date on
%s:\n%s\n" from err)))))))
- ;; Now run the FILE-CREATOR function on files.
- (cl-loop with fn = (quote ,file-creator)
- for (from . dest) in (quote
,async-fn-list)
- do (condition-case err
- (funcall fn from dest t)
- (file-error
- (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
- (write-region (point-min) (point-max)
- ,dired-async-log-file))))
- ,(dired-async-maybe-kill-ftp))
- callback)
- ;; Run mode-line notifications while process running.
- (dired-async--modeline-mode 1)
- (message "%s proceeding asynchronously..." operation))))
-
-;;;###autoload
-(define-minor-mode dired-async-mode
- "Do dired actions asynchronously."
- :global t
- (if dired-async-mode
- (advice-add 'dired-create-files :override #'dired-async-create-files)
- (advice-remove 'dired-create-files #'dired-async-create-files)))
-
-
-(provide 'dired-async)
-
-;;; dired-async.el ends here
diff --git a/packages/async/smtpmail-async.el b/packages/async/smtpmail-async.el
deleted file mode 100644
index ac26923..0000000
--- a/packages/async/smtpmail-async.el
+++ /dev/null
@@ -1,73 +0,0 @@
-;;; smtpmail-async.el --- Send e-mail with smtpmail.el asynchronously -*-
lexical-binding: t -*-
-
-;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
-
-;; Author: John Wiegley <address@hidden>
-;; Created: 18 Jun 2012
-
-;; Keywords: email 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
-;; published by the Free Software Foundation; either version 2, 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 GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Send e-mail with smtpmail.el asynchronously. To use:
-;;
-;; (require 'smtpmail-async)
-;;
-;; (setq send-mail-function 'async-smtpmail-send-it
-;; message-send-mail-function 'async-smtpmail-send-it)
-;;
-;; This assumes you already have smtpmail.el working.
-
-;;; Code:
-
-(defgroup smtpmail-async nil
- "Send e-mail with smtpmail.el asynchronously"
- :group 'smptmail)
-
-(require 'async)
-(require 'smtpmail)
-(require 'message)
-
-(defvar async-smtpmail-before-send-hook nil
- "Hook running in the child emacs in `async-smtpmail-send-it'.
-It is called just before calling `smtpmail-send-it'.")
-
-(defun async-smtpmail-send-it ()
- (let ((to (message-field-value "To"))
- (buf-content (buffer-substring-no-properties
- (point-min) (point-max))))
- (message "Delivering message to %s..." to)
- (async-start
- `(lambda ()
- (require 'smtpmail)
- (with-temp-buffer
- (insert ,buf-content)
- (set-buffer-multibyte nil)
- ;; Pass in the variable environment for smtpmail
- ,(async-inject-variables
-
"\\`\\(smtpmail\\|async-smtpmail\\|\\(user-\\)?mail\\)-\\|auth-sources\\|epg\\|nsm"
- nil
"\\`\\(mail-header-format-function\\|smtpmail-address-buffer\\|mail-mode-abbrev-table\\)")
- (run-hooks 'async-smtpmail-before-send-hook)
- (smtpmail-send-it)))
- (lambda (&optional _ignore)
- (message "Delivering message to %s...done" to)))))
-
-(provide 'smtpmail-async)
-
-;;; smtpmail-async.el ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] master c5a0196: * async: Make it an external,
Stefan Monnier <=