[elpa] master 3f751fb 082/187: Revert master back to 242ae73

[Michael Albinus]

branch: master
commit 3f751fb5b69d4ebabb18abb4cc22176aaf30a65c
Author: John Wiegley <address@hidden>
Commit: John Wiegley <address@hidden>

    Revert master back to 242ae73
---
 async-test.el |   74 ---------------------------------------------------------
 async.el      |   55 +----------------------------------------
 helm-async.el |   52 ++++++++++++++++++++--------------------
 3 files changed, 28 insertions(+), 153 deletions(-)

diff --git a/async-test.el b/async-test.el
index c1dbb0a..379cdf9 100644
--- a/async-test.el
+++ b/async-test.el
@@ -29,7 +29,6 @@
 
 ;;; Code:
 
-(add-to-list 'load-path (file-name-directory (or load-file-name 
(buffer-file-name))))
 (require 'async)
 (require 'async-file)
 
@@ -252,73 +251,6 @@ Return the name of the directory."
       (if (file-directory-p temp-dir)  (delete-directory temp-dir t))
       (if (file-directory-p temp-dir2) (delete-directory temp-dir2 t)))))
 
-(defun async-do-start-func-value-type-test ()
-  ;; Variable
-  (set 'myfunc-var (lambda () t))
-  ;; Function symbol
-  (fset 'myfunc-fsym myfunc-var)
-  ;; Defun
-  (defun myfunc-defun () t)
-
-  (should-error (error "ERROR"))
-
-  (should (eq t (eval '(async-sandbox myfunc-var))))
-  (should-error (eval '(async-sandbox 'myfunc-var)))
-  (should-error (eval '(async-sandbox #'myfunc-var)))
-
-  (should-error (eval '(async-sandbox myfunc-fsym)))
-  (should (eq t (eval '(async-sandbox 'myfunc-fsym))))
-  (should (eq t (eval '(async-sandbox #'myfunc-fsym))))
-
-  (should-error (eval '(async-sandbox myfunc-defun)))
-  (should (eq t (eval '(async-sandbox 'myfunc-defun))))
-  (should (eq t (eval '(async-sandbox #'myfunc-defun))))
-
-  (should (eq t (eval '(async-sandbox (lambda () t)))))
-  (should (eq t (eval '(async-sandbox '(lambda () t)))))
-  (should (eq t (eval '(async-sandbox #'(lambda () t)))))
-
-  (should-error (eval '(async-sandbox (closure (t) () t))))
-  (should (eq t (eval '(async-sandbox '(closure (t) () t)))))
-  (should (eq t (eval '(async-sandbox #'(closure (t) () t))))))
-
-(defun async-do-lexbind-test ()
-  ;; The `cl-loop' macro creates some lexical variables, and in this
-  ;; case one of those variables (the one that collects the result)
-  ;; gets set to a list of process objects, which are unprintable. If
-  ;; `lexical-binding' is non-nil, this unprintable value is
-  ;; incorporated into the closures created by `lambda' within the lexical
-  ;; scope of the loop, causing an error when another process tried to
-  ;; read in the printed value. `async--sanitize-closure' should
-  ;; prevent this by deleting the unprintable variable from the
-  ;; closure before printing it.
-  (eval
-   '(progn
-       (mapcar #'async-get
-               (cl-loop repeat 2 collect
-                        (async-start (lambda () t))))
-       (mapcar #'async-get
-               (cl-loop repeat 2 collect
-                        (async-start '(lambda () t))))
-       (mapcar #'async-get
-               (cl-loop repeat 2 collect
-                        (async-start #'(lambda () t))))
-       (mapcar #'async-get
-               (cl-loop repeat 2 collect
-                        (async-start `(lambda () ,(* 150 2))))))
-   t)
-  ;; The following lexical closure should work fine, since x, y, and z
-  ;; all have printable values.
-  (should
-   (eq 6
-       (eval
-        '(let ((x 1)
-               (y 2)
-               (z 3))
-           (async-sandbox (lambda () (+ x y z))))
-        t)
-       )))
-
 (ert-deftest async-copy-directory-lisp-sync-1 ()
   (async-do-copy-directory-test t nil nil :synchronously t))
 (ert-deftest async-copy-directory-lisp-sync-2 ()
@@ -346,12 +278,6 @@ Return the name of the directory."
 (ert-deftest async-copy-directory-native-4 ()
   (async-do-copy-directory-test t t t :use-native-commands t))
 
-(ert-deftest async-start-func-value-type-test ()
-  (async-do-start-func-value-type-test))
-
-(ert-deftest async-lexbind-test ()
-  (async-do-lexbind-test))
-
 (provide 'async-test)
 
 ;;; async-test.el ends here
diff --git a/async.el b/async.el
index 40663da..4c79816 100644
--- a/async.el
+++ b/async.el
@@ -142,51 +142,6 @@ as follows:
     (async--insert-sexp sexp)
     (process-send-region process (point-min) (point-max))))
 
-(defsubst async--value-printable-p (value)
-  "Return non-nil if VALUE can be round-tripped to a string prepresentation."
-  (condition-case nil
-      (let* ((value-string (prin1-to-string value))
-             (value-from-string (car (read-from-string value-string))))
-        (equal value value-from-string))
-    (error nil)))
-
-(defun async--sanitize-closure (func)
-  "If FUNC is a closure, delete unprintable lexicals from it."
-  (when (eq (car-safe func) 'closure)
-    (setf (cadr func)
-          (or (loop for obj in (cadr func)
-                    if (or (not (consp obj))
-                           (async--value-printable-p (cdr obj)))
-                    collect obj
-                    else do
-                    (when async-debug
-                      (message "Sanitized var from closure: %s=%S"
-                               (car obj) (cdr obj))))
-              ;; A closure with no lexicals generally has this value
-              ;; as its cadr, so we'll use that if everything gets
-              ;; filtered out.
-              '(t))))
-  func)
-
-(defsubst async--get-function (func)
-  "Get the function definition of FUNC, whatever it is.
-
-FUNC can be a variable name, a function definition, or an
-expression that evaluates to a function.
-
-This exists to get around the fact that closures are not
-self-quoting, so calling `eval' on them results in an error."
-  (indirect-function
-   (cond
-    ;; Quoted form => Extract value without evaluating since `(eval
-    ;; (quote (closure ...)))' is an error.
-    ((memq (car-safe func) '(quote function))
-     (cadr func))
-    ;; Anything else => eval it
-    ;; (e.g. variable or function call)
-    (t
-     (eval func)))))
-
 (defun async-batch-invoke ()
   "Called from the child Emacs process' command-line."
   (setq async-in-child-emacs t
@@ -305,14 +260,8 @@ 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'."
   (require 'find-func)
-  (let* ((procvar (make-symbol "proc"))
-         ;; Evaluate START-FUNC and resolve it to an actual function
-         ;; definition.
-         (start-func
-          (async--get-function start-func)))
-    (unless (functionp start-func)
-      (error "Start-func is not a function: %S" start-func))
-    `(let* ((sexp (async--sanitize-closure #',start-func))
+  (let ((procvar (make-symbol "proc")))
+    `(let* ((sexp ,start-func)
             (,procvar
              (async-start-process
               "emacs" (file-truename
diff --git a/helm-async.el b/helm-async.el
index dc001a8..de5d88b 100644
--- a/helm-async.el
+++ b/helm-async.el
@@ -125,7 +125,7 @@ This allow to turn off async features provided to this 
package."
     (unless (> (length processes) 1)
       (helm-async-mode -1))))
 
-(defun helm-async-after-file-create ()
+(defun helm-async-after-file-create (len-flist)
   "Callback function used for operation handled by `dired-create-file'."
   (unless (helm-async-processes)
     ;; Turn off mode-line notification
@@ -141,8 +141,8 @@ This allow to turn off async features provided to this 
package."
           (delete-file helm-async-log-file))
         (run-with-timer
          0.1 nil
-         helm-async-message-function "Asynchronous %s of %s file(s) done"
-         (car helm-async-operation) (cadr helm-async-operation)))))
+         helm-async-message-function "Asynchronous %s of %s file(s) on %s 
file(s) done"
+         (car helm-async-operation) (cadr helm-async-operation) len-flist))))
 
 (defun helm-async-maybe-kill-ftp ()
   "Return a form to kill ftp process in child emacs."
@@ -182,8 +182,8 @@ old file was marked."
   (setq helm-async-operation nil)
   (let (dired-create-files-failures failures async-fn-list
         skipped (success-count 0) (total (length fn-list))
-        (callback '(lambda (&optional ignore)
-                    (helm-async-after-file-create))))
+        (callback `(lambda (&optional ignore)
+                     (helm-async-after-file-create ,(length fn-list)))))
     (let (to overwrite-query
              overwrite-backup-query)   ; for dired-handle-overwrite
       (dolist (from fn-list)
@@ -263,19 +263,7 @@ ESC or `q' to not overwrite any of the remaining files,
                            failures)
                      (dired-log "%s `%s' to `%s' failed:\n%s\n"
                                 operation from to err)))))))))
-    (when (and async-fn-list helm-async-be-async)
-      (async-start `(lambda ()
-                      (require 'cl) (require 'dired-aux)
-                      ,(async-inject-variables helm-async-env-variables-regexp)
-                      (condition-case err
-                          (let ((dired-recursive-copies (quote always)))
-                            (loop for (f . d) in (quote ,async-fn-list)
-                                  do (funcall (quote ,file-creator) f d t)))
-                        (file-error
-                         (with-temp-file ,helm-async-log-file
-                           (insert (format "%S" err)))))
-                      ,(helm-async-maybe-kill-ftp))
-                   callback))
+    ;; Handle error happening in host emacs.
     (cond
      (dired-create-files-failures
       (setq failures (nconc failures dired-create-files-failures))
@@ -297,14 +285,26 @@ ESC or `q' to not overwrite any of the remaining files,
                 operation (length skipped) total
                 (dired-plural-s total))
        skipped))
-     (t
-      (if (and async-fn-list helm-async-be-async)
-          (progn
-            (helm-async-mode 1)
-            (setq helm-async-operation (list operation (length fn-list)))
-            (message "%s proceeding asynchronously..." operation))
-          (message "%s: %s file%s"
-                   operation success-count (dired-plural-s success-count))))))
+     (t (message "%s: %s file%s"
+                   operation success-count (dired-plural-s success-count))))
+    ;; Start async process.
+    (when (and async-fn-list helm-async-be-async)
+      (async-start `(lambda ()
+                      (require 'cl) (require 'dired-aux)
+                      ,(async-inject-variables helm-async-env-variables-regexp)
+                      (condition-case err
+                          (let ((dired-recursive-copies (quote always)))
+                            (loop for (f . d) in (quote ,async-fn-list)
+                                  do (funcall (quote ,file-creator) f d t)))
+                        (file-error
+                         (with-temp-file ,helm-async-log-file
+                           (insert (format "%S" err)))))
+                      ,(helm-async-maybe-kill-ftp))
+                   callback)
+      ;; Run mode-line notifications while process running.
+      (helm-async-mode 1)
+      (setq helm-async-operation (list operation (length async-fn-list)))
+      (message "%s proceeding asynchronously..." operation)))
   (unless helm-async-be-async
     (dired-move-to-filename)))