[elpa] master 85cedab 085/187: * async-file.el: Removed.

[Michael Albinus]

branch: master
commit 85cedab8204cf4cda5b021ed8ae77526e24689d0
Author: Thierry Volpiatto <address@hidden>
Commit: Thierry Volpiatto <address@hidden>

    * async-file.el: Removed.
    * dired-async.el: Removed.
---
 async-file.el  |  130 ------------------
 dired-async.el |  410 --------------------------------------------------------
 2 files changed, 0 insertions(+), 540 deletions(-)

diff --git a/async-file.el b/async-file.el
deleted file mode 100644
index 52a12b6..0000000
--- a/async-file.el
+++ /dev/null
@@ -1,130 +0,0 @@
-;;; async-file --- Asynchronous file operations
-
-;; Copyright (C) 2012~2013 John Wiegley
-
-;; 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:
-
-;; Provides asynchronous versions of the following operations:
-;;
-;;   Function                 Command equivalent
-;;   -----------------------  ---------------------------------
-;;   copy-file                cp
-;;   copy-directory           cp -R
-;;   rename-file              mv
-;;   delete-file              rm
-;;   delete-directory         rm -r
-;;
-;; Additional features:
-;;
-;; - If `async-file-use-native-commands' is non-nil, and none of the files
-;;   involved are `file-remote-p', the native command equivalents are used
-;;   above rather than spawning a child Emacs to call the related function.
-;;
-;; - Operations are queued, so that only one asynchronous operation is
-;;   performed at one time.  If an error occurs while processing the queue,
-;;   the whole queue is aborted.
-
-;;; Code:
-
-(eval-when-compile
-  (require 'cl))
-
-(defgroup async-file nil
-  "Asynchronous file processing using async.el"
-  :group 'async)
-
-(defcustom async-file-use-native-commands nil
-  "If non-nil, use native cp/mv/rm commands for local-only files."
-  :type 'boolean
-  :group 'async-file)
-
-(defun* async-copy-file
-    (file newname
-          &optional ok-if-already-exists keep-time
-          preserve-uid-gid preserve-selinux-context
-          &key (callback 'ignore))
-  "Asynchronous version of `copy-file'.
-Accepts a key argument `:callback' which takes a lambda that
-receives the return value from `copy-file' (nil if Lisp was used,
-a process object otherwise) when the copy is done."
-  (if (and async-file-use-native-commands
-           (not (or (file-remote-p file)
-                    (file-remote-p newname))))
-
-      (let ((args (list "-f" file newname)))
-        (if keep-time
-            (setq args (cons "-p" args)))
-        (unless ok-if-already-exists
-          (setq args (cons "-n" args)))
-        (apply #'async-start-process "cp" (executable-find "cp")
-               callback args))
-
-    (async-start (apply-partially #'copy-file
-                                  file newname ok-if-already-exists
-                                  keep-time preserve-uid-gid
-                                  preserve-selinux-context)
-                 callback)))
-
-(defun* async-copy-directory
-    (directory newname
-               &optional keep-time parents copy-contents
-               &key (callback 'ignore))
-  "Asynchronous version of `copy-directory'.
-Accepts a key argument `:callback' which takes a lambda that
-receives the return value from `copy-directory' (always nil) when
-the copy is done."
-  (if (and async-file-use-native-commands
-           (not (or (file-remote-p directory)
-                    (file-remote-p newname))))
-      (progn
-        (if parents
-            (let ((dest-dir (if copy-contents
-                                (file-name-directory newname)
-                              newname)))
-              (unless (file-directory-p dest-dir)
-                (message "Creating directory '%s'" dest-dir)
-                (make-directory dest-dir t))))
-
-        (if copy-contents
-            (let ((args (list "-r" (file-name-as-directory directory)
-                              (file-name-as-directory newname))))
-              (if keep-time
-                  (setq args (cons "-a" args)))
-              (apply #'async-start-process "rsync" (executable-find "rsync")
-                     callback args))
-
-          (let ((args (list "-fR" directory newname)))
-            (if keep-time
-                (setq args (cons "-p" args)))
-            (apply #'async-start-process "cp" (executable-find "cp")
-                   callback args))))
-
-    (async-start (apply-partially #'copy-directory
-                                  directory newname keep-time parents
-                                  copy-contents)
-                 callback)))
-
-(provide 'async-file)
-
-;;; async-file.el ends here
diff --git a/dired-async.el b/dired-async.el
deleted file mode 100644
index f601d1a..0000000
--- a/dired-async.el
+++ /dev/null
@@ -1,410 +0,0 @@
-;;; dired-async --- Copy/move/delete asynchronously in dired
-
-;; Copyright (C) 2012~2013 John Wiegley
-
-;; Author: John Wiegley <address@hidden>
-;; Created: 14 Jun 2012
-;; Version: 1.0
-;; 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:
-
-;; The function, which must be loaded *after* dired-aux.el, performs copies,
-;; moves and deletes in the background using a slave Emacs process, by means
-;; of the async.el module.  To use it, put this in your .emacs:
-;;
-;;   (eval-after-load "dired-aux"
-;;     '(require 'dired-async))
-;;
-;; NOTE: If you have `delete-by-moving-to-trash' set to t, and you enable
-;; `dired-async-use-native-commands', you will need to install the following
-;; bash script on your system's PATH as "rmtrash".  Please edit to suit your
-;; system.  It depends on the GNU realpath
-;;
-;; #!/bin/bash
-;;
-;; function mv_to_trash {
-;;     path="$1"
-;;     trash="$2"
-;;
-;;     if test -L "$path"; then
-;;         rm -f "$path"           # don't trash symlinks, just remove them
-;;     else
-;;         target="$trash"/$(basename "$path")
-;;         if test -e "$target"; then
-;;             for (( index=$$ ; 1; index=index+1 )); do
-;;                 target="$target"-"$index"
-;;                 if ! test -e "$target"; then
-;;                     break
-;;                 fi
-;;             done
-;;         fi
-;;         mv -f "$path" "$target" # don't worry about race-condition 
overwrites
-;;     fi
-;; }
-;;
-;; for item in "$@"; do
-;;     if [[ -n "$item" && ${item:0:1} == '-' ]]; then
-;;         continue
-;;     elif ! test -e "$item"; then
-;;         continue
-;;     else
-;;         target=$(realpath "$item")
-;;         if [[ "$target" =~ ^/Volumes/([^/]+)/ ]]; then
-;;             mv_to_trash "$item" "/Volumes/${BASH_REMATCH[1]}/.Trashes/$EUID"
-;;         else
-;;             mv_to_trash "$item" "$HOME/.Trash"
-;;         fi
-;;     fi
-;; done
-
-;;; Code:
-
-(require 'dired-aux)
-(require 'async)
-(require 'async-file)
-
-(defgroup dired-async nil
-  "Copy/move/delete asynchronously in dired"
-  :group 'dired)
-
-(defface dired-async-in-process-face
-  '((t (:background "yellow")))
-  "Face used to show that an asynchronous operation is in progress."
-  :group 'dired-async)
-
-(defvar dired-async-queue nil
-  "Queue of pending asynchronous file operations.
-Each operation that succeeds will start the next member of the queue.  If an
-error occurs at any point, the rest of the queue is flushed.")
-
-(defvar dired-async-use-native-commands nil
-  "If non-nil, use native commands like `rm' and `mv' for file operations. 
Otherwise use elisp.")
-
-(defun dired-async-highlight-file (file)
-  (save-excursion
-    (dired-goto-file file)
-    (let ((overlay (make-overlay (line-beginning-position)
-                                 (line-end-position))))
-      (overlay-put overlay 'face 'dired-async-in-process-face)
-      overlay)))
-
-(defun dired-async-remove-highlight (overlay)
-  (delete-overlay overlay))
-
-(defun dired-after-file-create (to actual-marker-char &optional overwrite)
-  (if overwrite
-      ;; If we get here, file-creator hasn't been aborted
-      ;; and the old entry (if any) has to be deleted
-      ;; before adding the new entry.
-      (dired-remove-file to))
-  (dired-add-file to actual-marker-char))
-
-(eval-when-compile
-  (defvar actual-marker-char)
-  (defvar overwrite)
-  (defvar async-callback))
-
-(defmacro dired-async-wrap-call (file callback forms)
-  `(let ((overlay (dired-async-highlight-file ,file)))
-     ,(if callback
-          `(setq ,callback `(lambda (ret)
-                              (dired-async-remove-highlight ,overlay)
-                              (funcall ,,callback ret))))
-     ,forms))
-
-(put 'dired-async-wrap-call 'lisp-indent-function 2)
-
-(defun dired-copy-file-recursive (from to ok-flag &optional
-                                       preserve-time top recursive)
-  (when (and (eq t (car (file-attributes from)))
-             (file-in-directory-p to from))
-    (error "Cannot copy `%s' into its subdirectory `%s'" from to))
-  (let ((attrs (file-attributes from))
-        (callback (if (boundp 'actual-marker-char)
-                      `(lambda (&optional ignore)
-                         (dired-after-file-create ,to ,actual-marker-char
-                                                  ,overwrite))
-                    (lambda (&optional ignore)))))
-    (if (and recursive
-             (eq t (car attrs))
-             (or (eq recursive 'always)
-                 (yes-or-no-p (format "Recursive copies of %s? " from))))
-        ;; This is a directory.
-        (dired-async-wrap-call from callback
-          (async-copy-file from to ok-flag preserve-time nil nil
-                           :callback callback))
-      ;; Not a directory.
-      (or top (dired-handle-overwrite to))
-      (condition-case err
-          (if (stringp (car attrs))
-              ;; It is a symlink
-              (make-symbolic-link (car attrs) to ok-flag)
-            (dired-async-wrap-call from callback
-              (async-copy-file from to ok-flag preserve-time nil nil
-                               :callback callback)))
-        (file-date-error
-         (push (dired-make-relative from)
-               dired-create-files-failures)
-         (dired-log "Can't set date on %s:\n%s\n" from err))))))
-
-(defun dired-rename-file (file newname ok-if-already-exists)
-  (dired-handle-overwrite newname)
-  (let ((callback
-         (if (boundp 'actual-marker-char)
-             `(lambda (&optional ignore)
-                ;; Silently rename the visited file of any buffer visiting this
-                ;; file.
-                (and (get-file-buffer ,file)
-                     (with-current-buffer (get-file-buffer ,file)
-                       (set-visited-file-name ,newname nil t)))
-                (dired-remove-file ,file)
-                ;; See if it's an inserted subdir, and rename that, too.
-                (dired-rename-subdir ,file ,newname)
-
-                (dired-after-file-create ,newname ,actual-marker-char
-                                         ,overwrite))
-           (lambda (&optional ignore)))))
-    (if (and dired-async-use-native-commands
-             (not (file-remote-p file))
-             (not (file-remote-p newname)))
-        (let ((args (list "-f" file newname)))
-          (unless ok-if-already-exists
-            (setq args (cons "-n" args)))
-          (apply #'async-start-process "mv" (executable-find "mv")
-                 callback args))
-      (dired-async-wrap-call file callback
-        (async-start (apply-partially #'rename-file file newname
-                                      ok-if-already-exists)
-                     callback)))))
-
-(defun dired-delete-file (file &optional recursive trash) "\
-Delete FILE or directory (possibly recursively if optional RECURSIVE is true.)
-RECURSIVE determines what to do with a non-empty directory.  If RECURSIVE is:
-nil, do not delete.
-`always', delete recursively without asking.
-`top', ask for each directory at top level.
-Anything else, ask for each sub-directory."
-  ;; This test is equivalent to
-  ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
-  ;; but more efficient
-  (if (not (eq t (car (file-attributes file))))
-      (dired-async-wrap-call file nil
-        (cond
-         ;; How to reliably trash files on other systems?  Use Emacs to do it
-         (trash
-          (async-start-process "rmtrash" (executable-find "rmtrash")
-                               'ignore "-f" file))
-         ((and (not trash) dired-async-use-native-commands
-               (not (file-remote-p file)))
-          (async-start-process "rm" (executable-find "rm") 'ignore "-f" file))
-         (t
-          (async-start (apply-partially #'delete-file file trash)
-                       'ignore))))
-    (if (and recursive
-             (directory-files file t dired-re-no-dot) ; Not empty.
-             (or (eq recursive 'always)
-                 (yes-or-no-p (format "Recursively %s %s? "
-                                      (if (and trash
-                                               delete-by-moving-to-trash)
-                                          "trash"
-                                        "delete")
-                                      (dired-make-relative file)))))
-        (if (eq recursive 'top) (setq recursive 'always)) ; Don't ask again.
-      (setq recursive nil))
-    (dired-async-wrap-call file nil
-      (if (and dired-async-use-native-commands
-               (not (file-remote-p file)))
-          (if recursive
-              (if trash
-                  (async-start-process "rmtrash" (executable-find "rmtrash")
-                                       'ignore "-fr" file)
-                (async-start-process "rm" (executable-find "rm")
-                                     'ignore "-fr" file))
-            (async-start-process "rmdir" (executable-find "rmdir")
-                                 'ignore file))
-        (async-start (apply-partially #'delete-directory file recursive trash)
-                     'ignore)))))
-
-(defun dired-create-files (file-creator operation fn-list name-constructor
-                                        &optional marker-char)
-  "Create one or more new files from a list of existing files FN-LIST.
-This function also handles querying the user, updating Dired
-buffers, and displaying a success or failure message.
-
-FILE-CREATOR should be a function.  It is called once for each
-file in FN-LIST, and must create a new file, querying the user
-and updating Dired buffers as necessary.  It should accept three
-arguments: the old file name, the new name, and an argument
-OK-IF-ALREADY-EXISTS with the same meaning as in `copy-file'.
-
-OPERATION should be a capitalized string describing the operation
-performed (e.g. `Copy').  It is used for error logging.
-
-FN-LIST is the list of files to copy (full absolute file names).
-
-NAME-CONSTRUCTOR should be a function accepting a single
-argument, the name of an old file, and returning either the
-corresponding new file name or nil to skip.
-
-Optional MARKER-CHAR is a character with which to mark every
-newfile's entry, or t to use the current marker character if the
-old file was marked."
-  (let (dired-create-files-failures
-        failures skipped (success-count 0) (total (length fn-list)))
-    (let (to overwrite-query
-             overwrite-backup-query)   ; for dired-handle-overwrite
-      (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 (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))))
-                 ;; must determine if FROM is marked before file-creator
-                 ;; gets a chance to delete it (in case of a move).
-                 (actual-marker-char
-                  (cond  ((integerp marker-char) marker-char)
-                         (marker-char (dired-file-marker from)) ; slow
-                         (t nil))))
-            ;; 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)))
-            (condition-case err
-                (funcall file-creator from to dired-overwrite-confirmed)
-              (file-error              ; FILE-CREATOR aborted
-               (progn
-                 (push (dired-make-relative from)
-                       failures)
-                 (dired-log "%s `%s' to `%s' failed:\n%s\n"
-                            operation from to err))))))))
-    (cond
-     (dired-create-files-failures
-      (setq failures (nconc failures dired-create-files-failures))
-      (dired-log-summary
-       (format "%s failed for %d file%s in %d requests"
-               operation (length failures)
-               (dired-plural-s (length failures))
-               total)
-       failures))
-     (failures
-      (dired-log-summary
-       (format "%s failed for %d of %d file%s"
-               operation (length failures)
-               total (dired-plural-s total))
-       failures))
-     (skipped
-      (dired-log-summary
-       (format "%s: %d of %d file%s skipped"
-               operation (length skipped) total
-               (dired-plural-s total))
-       skipped))
-     (t
-      (message "%s proceeding asynchronously..." operation)))))
-
-(defun dired-internal-do-deletions (l arg &optional trash)
-  ;; L is an alist of files to delete, with their buffer positions.
-  ;; ARG is the prefix arg.
-  ;; Filenames are absolute.
-  ;; (car L) *must* be the *last* (bottommost) file in the dired buffer.
-  ;; That way as changes are made in the buffer they do not shift the
-  ;; lines still to be changed, so the (point) values in L stay valid.
-  ;; Also, for subdirs in natural order, a subdir's files are deleted
-  ;; before the subdir itself - the other way around would not work.
-  (let* ((files (mapcar (function car) l))
-         (count (length l))
-         (succ 0)
-         (trashing (and trash delete-by-moving-to-trash))
-         (progress-reporter
-          (make-progress-reporter
-           (if trashing "Trashing..." "Deleting...")
-           succ count)))
-    ;; canonicalize file list for pop up
-    (setq files (nreverse (mapcar (function dired-make-relative) files)))
-    (if (dired-mark-pop-up
-         " *Deletions*" 'delete files dired-deletion-confirmer
-         (format "%s %s "
-                 (if trashing "Trash" "Delete")
-                 (dired-mark-prompt arg files)))
-        (save-excursion
-          (let (failures);; files better be in reverse order for this loop!
-            (while l
-              (goto-char (cdr (car l)))
-              (let ((inhibit-read-only t))
-                (condition-case err
-                    (let ((fn (car (car l))))
-                      (dired-delete-file fn dired-recursive-deletes trash)
-                      ;; if we get here, removing worked
-                      (setq succ (1+ succ))
-                      (progress-reporter-update progress-reporter succ)
-                      (dired-fun-in-all-buffers
-                       (file-name-directory fn) (file-name-nondirectory fn)
-                       (function dired-delete-entry) fn))
-                  (error;; catch errors from failed deletions
-                   (dired-log "%s\n" err)
-                   (setq failures (cons (car (car l)) failures)))))
-              (setq l (cdr l)))
-            (if (not failures)
-                (progress-reporter-done progress-reporter)
-              (dired-log-summary
-               (format "%d of %d deletion%s failed"
-                       (length failures) count
-                       (dired-plural-s count))
-               failures))))
-      (message "(No deletions performed)"))))
-
-(provide 'dired-async)
-
-;;; dired-async.el ends here