[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 85cedab 085/187: * async-file.el: Removed.
From: |
Michael Albinus |
Subject: |
[elpa] master 85cedab 085/187: * async-file.el: Removed. |
Date: |
Wed, 30 Dec 2015 11:49:51 +0000 |
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
- [elpa] master 4d14cbb 094/187: * async-test.el: Update copyrights., (continued)
- [elpa] master 4d14cbb 094/187: * async-test.el: Update copyrights., Michael Albinus, 2015/12/30
- [elpa] master 3712607 097/187: * smtpmail-async.el: Exclude some vars when injecting (#22)., Michael Albinus, 2015/12/30
- [elpa] master a0195ad 104/187: Fix markdown in README, Michael Albinus, 2015/12/30
- [elpa] master 3a23aa1 095/187: * dired-async.el (helm-async-be-async): Move it as obsolete variable alias to helm., Michael Albinus, 2015/12/30
- [elpa] master eaa0ec1 098/187: * smtpmail-async.el: Fix encoding problems (#27), Michael Albinus, 2015/12/30
- [elpa] master 05c9861 103/187: * smtpmail-async.el (async-smtpmail-before-send-hook): Add docstring., Michael Albinus, 2015/12/30
- [elpa] master b2b4bd6 107/187: * async-bytecomp.el: New file., Michael Albinus, 2015/12/30
- [elpa] master b67254c 096/187: * smtpmail-async.el (async-smtpmail-send-it): Eval content of buffer outside temp buffer.(attempt to fix issue in mu4e), Michael Albinus, 2015/12/30
- [elpa] master 1c54de3 091/187: * README.md: Update., Michael Albinus, 2015/12/30
- [elpa] master f48fe54 099/187: * smtpmail-async.el: Try to catch 'done to not exit when smtpmail-via-smtp is recalled (#22)., Michael Albinus, 2015/12/30
- [elpa] master 85cedab 085/187: * async-file.el: Removed.,
Michael Albinus <=
- [elpa] master addec5e 102/187: * smtpmail-async.el (async-smtpmail-send-it): Inject the value of auth-sources (#22), Michael Albinus, 2015/12/30
- [elpa] master cca41ed 106/187: * README.md: Fix typo., Michael Albinus, 2015/12/30
- [elpa] master fe319a7 101/187: * smtpmail-async.el (async-smtpmail-before-send-hook): New hook that run on child emacs before sending., Michael Albinus, 2015/12/30
- [elpa] master b962cbf 105/187: Merge pull request #32 from Trevoke/patch-1, Michael Albinus, 2015/12/30
- [elpa] master ed0202f 109/187: fix #33 async-start evals (symbol-file 'async-batch-invoke 'defun) at compile time, Michael Albinus, 2015/12/30
- [elpa] master f81ff95 108/187: Remove version number in all files., Michael Albinus, 2015/12/30
- [elpa] master 79e6110 113/187: Add comments, no--code-change., Michael Albinus, 2015/12/30
- [elpa] master 9f038b4 112/187: * smtpmail-async.el: require message to shutup byte compiler., Michael Albinus, 2015/12/30
- [elpa] master 73d8920 100/187: * smtpmail-async.el: Revert previous change (catch)., Michael Albinus, 2015/12/30
- [elpa] master c52a60f 115/187: Merge pull request #34 from michael-heerdegen/fix-33, Michael Albinus, 2015/12/30