From: Andreas Gerler Date: Thu, 24 Dec 2015 16:45:34 +0000 (+0100) Subject: updating async. X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=4d38407b36d763b72d7bd68505db5938c54b52ad;p=emacsconfig.git updating async. --- diff --git a/bba.org b/bba.org index b9270424..df03fcbe 100644 --- a/bba.org +++ b/bba.org @@ -158,7 +158,7 @@ Keep track of your important stuff! #+BEGIN_SRC emacs-lisp (if (>= emacs-major-version 24) (progn - (add-to-list 'load-path "~/.emacs.d/elpa/async-20150529.529") + (add-to-list 'load-path "~/.emacs.d/elpa/async-20151123.256") (require 'async) ) ) @@ -754,47 +754,47 @@ Very useful for repetitive literate devops jobs. #+BEGIN_SRC emacs-lisp - ;; (setq org-clock-persist 'history) - (org-clock-persistence-insinuate) - (setq org-clock-persist t) - (setq org-default-notes-file (concat org-directory "/refile.org")) - (define-key global-map "\C-cc" 'org-capture) + ;; (setq org-clock-persist 'history) + (org-clock-persistence-insinuate) + (setq org-clock-persist t) + (setq org-default-notes-file (concat org-directory "/refile.org")) + (define-key global-map "\C-cc" 'org-capture) - (setq org-capture-templates + (setq org-capture-templates - '(("t" "todo" entry (file+headline "~/org/refile.org" "Tasks") - "* TODO %^{Task}\n%U\n + '(("t" "todo" entry (file+headline "~/org/refile.org" "Tasks") + "* TODO %^{Task}\n%U\n - %i\n - %a\n - %? - ") + %i\n + %a\n + %? + ") - ("m" "Meeting" entry (file "~/org/refile.org") - "* MEETING with %? :MEETING:\n%U" :clock-in t :clock-resume t) + ("m" "Meeting" entry (file "~/org/refile.org") + "* MEETING with %? :MEETING:\n%U" :clock-in t :clock-resume t) - ("n" "note" entry (file+headline "~/org/refile.org" "Note") - "* NOTE %?\n%U\n + ("n" "note" entry (file+headline "~/org/refile.org" "Note") + "* NOTE %?\n%U\n - %i\n - %a") + %i\n + %a") - ("w" "work todo" (file+headline "~/workorg/work.org" "todolist") - "* TODO %{Task}\n%U\n + ("w" "work todo" entry (file+headline "~/workorg/work.org" "Tasks") + "* TODO %^{Task}\n%U\n - %i\n - %a\n - %?" - ) + %i\n + %a\n + %? + ") - ("j" "Journal" entry (file+datetree "~/git/org/diary.org") - "* %?\n%U\n" :clock-in t :clock-resume t) + ("j" "Journal" entry (file+datetree "~/git/org/diary.org") + "* %?\n%U\n" :clock-in t :clock-resume t) - ("l" "Links (it)" entry (file+headline "~/org/refile.org" "Links") - "** %c\n\n %u\n %i" - :empty-lines 1) + ("l" "Links (it)" entry (file+headline "~/org/refile.org" "Links") + "** %c\n\n %u\n %i" + :empty-lines 1) - )) + )) #+END_SRC diff --git a/elpa/async-20150529.529/async-autoloads.el b/elpa/async-20150529.529/async-autoloads.el deleted file mode 100644 index 683bece4..00000000 --- a/elpa/async-20150529.529/async-autoloads.el +++ /dev/null @@ -1,129 +0,0 @@ -;;; async-autoloads.el --- automatically extracted autoloads -;; -;;; Code: -(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) - -;;;### (autoloads nil "async" "async.el" (21908 14300 0 0)) -;;; Generated autoloads from async.el - -(autoload 'async-start-process "async" "\ -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. - -\(fn NAME PROGRAM FINISH-FUNC &rest PROGRAM-ARGS)" nil nil) - -(autoload 'async-start "async" "\ -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 form 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'. - -\(fn START-FUNC &optional FINISH-FUNC)" nil t) - -;;;*** - -;;;### (autoloads nil "async-bytecomp" "async-bytecomp.el" (21908 -;;;;;; 14300 0 0)) -;;; Generated autoloads from async-bytecomp.el - -(autoload 'async-byte-recompile-directory "async-bytecomp" "\ -Compile all *.el files in DIRECTORY asynchronously. -All *.elc files are systematically deleted before proceeding. - -\(fn DIRECTORY &optional QUIET)" nil nil) - -(defvar async-bytecomp-package-mode nil "\ -Non-nil if Async-Bytecomp-Package mode is enabled. -See the command `async-bytecomp-package-mode' for a description of this minor mode. -Setting this variable directly does not take effect; -either customize it (see the info node `Easy Customization') -or call the function `async-bytecomp-package-mode'.") - -(custom-autoload 'async-bytecomp-package-mode "async-bytecomp" nil) - -(autoload 'async-bytecomp-package-mode "async-bytecomp" "\ -Byte compile asynchronously packages installed with package.el. -Async compilation of packages can be controlled by -`async-bytecomp-allowed-packages'. - -\(fn &optional ARG)" t nil) - -;;;*** - -;;;### (autoloads nil "dired-async" "dired-async.el" (21908 14300 -;;;;;; 0 0)) -;;; Generated autoloads from dired-async.el - -(defvar dired-async-mode nil "\ -Non-nil if Dired-Async mode is enabled. -See the command `dired-async-mode' for a description of this minor mode. -Setting this variable directly does not take effect; -either customize it (see the info node `Easy Customization') -or call the function `dired-async-mode'.") - -(custom-autoload 'dired-async-mode "dired-async" nil) - -(autoload 'dired-async-mode "dired-async" "\ -Do dired actions asynchronously. - -\(fn &optional ARG)" t nil) - -;;;*** - -;;;### (autoloads nil nil ("async-pkg.el" "smtpmail-async.el") (21908 -;;;;;; 14300 316611 0)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; End: -;;; async-autoloads.el ends here diff --git a/elpa/async-20150529.529/async-bytecomp.el b/elpa/async-20150529.529/async-bytecomp.el deleted file mode 100644 index 00043472..00000000 --- a/elpa/async-20150529.529/async-bytecomp.el +++ /dev/null @@ -1,160 +0,0 @@ -;;; async-bytecomp.el --- Async functions to compile elisp files async - -;; Copyright (C) 2014 John Wiegley -;; Copyright (C) 2014 Thierry Volpiatto - -;; Authors: John Wiegley -;; Thierry Volpiatto - -;; 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) - "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 "~/.emacs.d/async-bytecomp.log") - -;;;###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) -(declare-function package-desc-reqs "package.el" (cl-x)) - -(defun async-bytecomp--get-package-deps (pkg &optional only) - (let* ((pkg-desc (cadr (assq pkg package-archive-contents))) - (direct-deps (cl-loop for p in (package-desc-reqs pkg-desc) - for name = (car p) - when (assq name package-archive-contents) - 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)) - (cl-loop for p in async-bytecomp-allowed-packages - append (async-bytecomp--get-package-deps p) into reqs - finally return - (delete-dups - (append async-bytecomp-allowed-packages reqs))))) - -(defadvice package--compile (around byte-compile-async) - (let ((cur-package (package-desc-name pkg-desc))) - (if (or (equal async-bytecomp-allowed-packages '(all)) - (memq cur-package (async-bytecomp-get-allowed-pkgs))) - (progn - (when (eq cur-package 'async) - (fmakunbound 'async-byte-recompile-directory)) - (package-activate-1 pkg-desc) - (load "async-bytecomp") ; emacs-24.3 don't reload new files. - (async-byte-recompile-directory (package-desc-dir pkg-desc) t)) - ad-do-it))) - -;;;###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 - (ad-activate 'package--compile) - (ad-deactivate 'package--compile))) - -(provide 'async-bytecomp) - -;;; async-bytecomp.el ends here diff --git a/elpa/async-20150529.529/async-pkg.el b/elpa/async-20150529.529/async-pkg.el deleted file mode 100644 index da89a153..00000000 --- a/elpa/async-20150529.529/async-pkg.el +++ /dev/null @@ -1,4 +0,0 @@ -(define-package "async" "20150529.529" "Asynchronous processing in Emacs" 'nil) -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/async-20150529.529/async.el b/elpa/async-20150529.529/async.el deleted file mode 100644 index be9c04e5..00000000 --- a/elpa/async-20150529.529/async.el +++ /dev/null @@ -1,292 +0,0 @@ -;;; async --- Asynchronous processing in Emacs - -;; Copyright (C) 2012~2014 John Wiegley - -;; Author: John Wiegley -;; Created: 18 Jun 2012 - -;; 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) - -(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 sentinal 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))) - (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))) - -(defun async--insert-sexp (sexp) - (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." - (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 the ready 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)) - (with-current-buffer (process-buffer future) - async-callback-value-set))) - -(defun async-wait (future) - "Wait for FUTURE to become ready." - (while (not (async-ready future)) - (sit-for 0.05))) - -(defun async-get (future) - "Get the value from an asynchronously function when it is ready. -FUTURE is returned by `async-start' or `async-start-process' when -its FINISH-FUNC is nil." - (async-wait future) - (with-current-buffer (process-buffer future) - (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 (&rest args) - "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 -(defmacro 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 form 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'." - (require 'find-func) - (let ((procvar (make-symbol "proc"))) - `(let* ((sexp ,start-func) - (,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 - "" - (with-temp-buffer - (async--insert-sexp (list 'quote sexp)) - (buffer-string)))))) - (if async-send-over-pipe - (async--transmit-sexp ,procvar (list 'quote sexp))) - ,procvar))) - -(defmacro async-sandbox(func) - "Evaluate FUNC in a separate Emacs process, synchronously." - `(async-get (async-start ,func))) - -(provide 'async) - -;;; async.el ends here diff --git a/elpa/async-20150529.529/dired-async.el b/elpa/async-20150529.529/dired-async.el deleted file mode 100644 index d37c5cb1..00000000 --- a/elpa/async-20150529.529/dired-async.el +++ /dev/null @@ -1,282 +0,0 @@ -;;; dired-async.el --- Copy/move/delete asynchronously in dired. - -;; Copyright (C) 2012~2014 John Wiegley -;; Copyright (C) 2012~2014 Thierry Volpiatto - -;; Authors: John Wiegley -;; Thierry Volpiatto - -;; 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, -;; which must be loaded *after* dired-aux.el, 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: -;; -;; (eval-after-load "dired-aux" -;; '(require 'dired-async)) -;; -;; - -;;; Code: - -(require 'cl-lib) -(require 'dired-aux) -(require 'async) - -(eval-when-compile - (defvar async-callback)) -(defvar dired-async-operation nil) - -(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 - :group 'dired-async) - -(defcustom dired-async-message-function 'dired-async-mode-line-message - "Function to use to notify result when operation finish. -Should take same args as `message'." - :group 'dired-async - :type 'function) - -(defcustom dired-async-log-file "/tmp/dired-async.log" - "File use to communicate errors from Child Emacs to host Emacs." - :group 'dired-async - :type 'string) - -(defface dired-async-message - '((t (:foreground "yellow"))) - "Face used for mode-line message." - :group 'dired-async) - -(defface dired-async-mode-message - '((t (:background "Firebrick1"))) - "Face used for `dired-async--modeline-mode' lighter." - :group 'dired-async) - -(define-minor-mode dired-async--modeline-mode - "Notify mode-line that an async process run." - :group 'dired-async - :global t - :lighter (:eval (propertize (format " [%s Async job(s) running]" - (length (dired-async-processes))) - 'face 'dired-async-mode-message)) - (unless dired-async--modeline-mode - (let ((visible-bell t)) (ding)))) - -(defun dired-async-mode-line-message (text &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 'dired-async-message)))) - (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)))) - (delete-process proc) - (unless (> (length processes) 1) - (dired-async--modeline-mode -1)))) - -(defun dired-async-after-file-create (len-flist) - "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 dired-async-operation - (if (file-exists-p dired-async-log-file) - (progn - (pop-to-buffer (get-buffer-create "*dired async*")) - (erase-buffer) - (insert "Error: ") - (insert-file-contents dired-async-log-file) - (delete-file dired-async-log-file)) - (run-with-timer - 0.1 nil - dired-async-message-function "Asynchronous %s of %s file(s) on %s file(s) done" - (car dired-async-operation) (cadr dired-async-operation) len-flist)))) - -(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)))))) - -(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 dired-async-operation nil) - (let (dired-create-files-failures failures async-fn-list - skipped (success-count 0) (total (length fn-list)) - (callback `(lambda (&optional ignore) - (dired-async-after-file-create ,(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))) - (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" - operation from to))) - (push (cons from to) async-fn-list)))))) - ;; Handle error happening in host emacs. - (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: %s file%s" - operation success-count (dired-plural-s success-count)))) - ;; 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) - (condition-case err - (let ((dired-recursive-copies (quote always))) - (cl-loop for (f . d) in (quote ,async-fn-list) - do (funcall (quote ,file-creator) f d t))) - (file-error - (with-temp-file ,dired-async-log-file - (insert (format "%S" err))))) - ,(dired-async-maybe-kill-ftp)) - callback) - ;; Run mode-line notifications while process running. - (dired-async--modeline-mode 1) - (setq dired-async-operation (list operation (length async-fn-list))) - (message "%s proceeding asynchronously..." operation)))) - -(defadvice dired-create-files (around dired-async) - (dired-async-create-files file-creator operation fn-list - name-constructor marker-char)) - -;;;###autoload -(define-minor-mode dired-async-mode - "Do dired actions asynchronously." - :group 'dired-async - :global t - (if dired-async-mode - (if (fboundp 'advice-add) - (advice-add 'dired-create-files :override #'dired-async-create-files) - (ad-activate 'dired-create-files)) - (if (fboundp 'advice-remove) - (advice-remove 'dired-create-files #'dired-async-create-files) - (ad-deactivate 'dired-create-files)))) - - -(provide 'dired-async) - -;;; dired-async.el ends here diff --git a/elpa/async-20150529.529/smtpmail-async.el b/elpa/async-20150529.529/smtpmail-async.el deleted file mode 100644 index d487f930..00000000 --- a/elpa/async-20150529.529/smtpmail-async.el +++ /dev/null @@ -1,73 +0,0 @@ -;;; smtpmail-async --- Send e-mail with smtpmail.el asynchronously - -;; Copyright (C) 2012~2014 John Wiegley - -;; Author: John Wiegley -;; 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" - 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 diff --git a/elpa/async-20151123.256/async-autoloads.el b/elpa/async-20151123.256/async-autoloads.el new file mode 100644 index 00000000..c3002567 --- /dev/null +++ b/elpa/async-20151123.256/async-autoloads.el @@ -0,0 +1,129 @@ +;;; async-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil "async" "async.el" (22140 8226 0 0)) +;;; Generated autoloads from async.el + +(autoload 'async-start-process "async" "\ +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. + +\(fn NAME PROGRAM FINISH-FUNC &rest PROGRAM-ARGS)" nil nil) + +(autoload 'async-start "async" "\ +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 form 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'. + +\(fn START-FUNC &optional FINISH-FUNC)" nil t) + +;;;*** + +;;;### (autoloads nil "async-bytecomp" "async-bytecomp.el" (22140 +;;;;;; 8226 0 0)) +;;; Generated autoloads from async-bytecomp.el + +(autoload 'async-byte-recompile-directory "async-bytecomp" "\ +Compile all *.el files in DIRECTORY asynchronously. +All *.elc files are systematically deleted before proceeding. + +\(fn DIRECTORY &optional QUIET)" nil nil) + +(defvar async-bytecomp-package-mode nil "\ +Non-nil if Async-Bytecomp-Package mode is enabled. +See the command `async-bytecomp-package-mode' for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `async-bytecomp-package-mode'.") + +(custom-autoload 'async-bytecomp-package-mode "async-bytecomp" nil) + +(autoload 'async-bytecomp-package-mode "async-bytecomp" "\ +Byte compile asynchronously packages installed with package.el. +Async compilation of packages can be controlled by +`async-bytecomp-allowed-packages'. + +\(fn &optional ARG)" t nil) + +;;;*** + +;;;### (autoloads nil "dired-async" "dired-async.el" (22140 8226 +;;;;;; 0 0)) +;;; Generated autoloads from dired-async.el + +(defvar dired-async-mode nil "\ +Non-nil if Dired-Async mode is enabled. +See the command `dired-async-mode' for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `dired-async-mode'.") + +(custom-autoload 'dired-async-mode "dired-async" nil) + +(autoload 'dired-async-mode "dired-async" "\ +Do dired actions asynchronously. + +\(fn &optional ARG)" t nil) + +;;;*** + +;;;### (autoloads nil nil ("async-pkg.el" "smtpmail-async.el") (22140 +;;;;;; 8226 463061 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; async-autoloads.el ends here diff --git a/elpa/async-20151123.256/async-bytecomp.el b/elpa/async-20151123.256/async-bytecomp.el new file mode 100644 index 00000000..53d288da --- /dev/null +++ b/elpa/async-20151123.256/async-bytecomp.el @@ -0,0 +1,172 @@ +;;; async-bytecomp.el --- Async functions to compile elisp files async + +;; Copyright (C) 2014 John Wiegley +;; Copyright (C) 2014 Thierry Volpiatto + +;; Authors: John Wiegley +;; Thierry Volpiatto + +;; 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 "~/.emacs.d/async-bytecomp.log") + +;;;###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) +(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'. + (let* ((pkg-desc (cadr (assq pkg package-archive-contents))) + (direct-deps (cl-loop for p in (package-desc-reqs pkg-desc) + for name = (car p) + when (assq name package-archive-contents) + 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))) + +(defadvice package--compile (around byte-compile-async) + (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 + (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)) + ad-do-it))) + +;;;###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 + (ad-activate 'package--compile) + (ad-deactivate 'package--compile))) + +(provide 'async-bytecomp) + +;;; async-bytecomp.el ends here diff --git a/elpa/async-20151123.256/async-pkg.el b/elpa/async-20151123.256/async-pkg.el new file mode 100644 index 00000000..16c98c65 --- /dev/null +++ b/elpa/async-20151123.256/async-pkg.el @@ -0,0 +1,7 @@ +(define-package "async" "20151123.256" "Asynchronous processing in Emacs" + '((emacs "24") + (cl-lib "0.5")) + :url "https://github.com/jwiegley/emacs-async") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/async-20151123.256/async.el b/elpa/async-20151123.256/async.el new file mode 100644 index 00000000..e41b39de --- /dev/null +++ b/elpa/async-20151123.256/async.el @@ -0,0 +1,293 @@ +;;; async.el --- Asynchronous processing in Emacs + +;; Copyright (C) 2012~2014 John Wiegley + +;; Author: John Wiegley +;; Created: 18 Jun 2012 + +;; 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) + +(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 sentinal 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))) + (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))) + +(defun async--insert-sexp (sexp) + (let (print-level print-length) + (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." + (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 the ready 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)) + (with-current-buffer (process-buffer future) + async-callback-value-set))) + +(defun async-wait (future) + "Wait for FUTURE to become ready." + (while (not (async-ready future)) + (sit-for 0.05))) + +(defun async-get (future) + "Get the value from an asynchronously function when it is ready. +FUTURE is returned by `async-start' or `async-start-process' when +its FINISH-FUNC is nil." + (async-wait future) + (with-current-buffer (process-buffer future) + (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 (&rest args) + "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 +(defmacro 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 form 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'." + (require 'find-func) + (let ((procvar (make-symbol "proc"))) + `(let* ((sexp ,start-func) + (,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 + "" + (with-temp-buffer + (async--insert-sexp (list 'quote sexp)) + (buffer-string)))))) + (if async-send-over-pipe + (async--transmit-sexp ,procvar (list 'quote sexp))) + ,procvar))) + +(defmacro async-sandbox(func) + "Evaluate FUNC in a separate Emacs process, synchronously." + `(async-get (async-start ,func))) + +(provide 'async) + +;;; async.el ends here diff --git a/elpa/async-20151123.256/dired-async.el b/elpa/async-20151123.256/dired-async.el new file mode 100644 index 00000000..3f5349da --- /dev/null +++ b/elpa/async-20151123.256/dired-async.el @@ -0,0 +1,291 @@ +;;; dired-async.el --- Copy/move/delete asynchronously in dired. + +;; Copyright (C) 2012~2014 John Wiegley +;; Copyright (C) 2012~2014 Thierry Volpiatto + +;; Authors: John Wiegley +;; Thierry Volpiatto + +;; 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)) +(defvar dired-async-operation nil) + +(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 + :group 'dired-async) + +(defcustom dired-async-message-function 'dired-async-mode-line-message + "Function to use to notify result when operation finish. +Should take same args as `message'." + :group 'dired-async + :type 'function) + +(defcustom dired-async-log-file "/tmp/dired-async.log" + "File use to communicate errors from Child Emacs to host Emacs." + :group 'dired-async + :type 'string) + +(defface dired-async-message + '((t (:foreground "yellow"))) + "Face used for mode-line message." + :group 'dired-async) + +(defface dired-async-mode-message + '((t (:foreground "Gold"))) + "Face used for `dired-async--modeline-mode' lighter." + :group 'dired-async) + +(define-minor-mode dired-async--modeline-mode + "Notify mode-line that an async process run." + :group 'dired-async + :global t + :lighter (:eval (propertize (format " [%s Async job(s) running]" + (length (dired-async-processes))) + 'face 'dired-async-mode-message)) + (unless dired-async--modeline-mode + (let ((visible-bell t)) (ding)))) + +(defun dired-async-mode-line-message (text &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 'dired-async-message)))) + (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)))) + (delete-process proc) + (unless (> (length processes) 1) + (dired-async--modeline-mode -1)))) + +(defun dired-async-after-file-create (len-flist) + "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 dired-async-operation + (if (file-exists-p dired-async-log-file) + (progn + (pop-to-buffer (get-buffer-create "*dired async*")) + (erase-buffer) + (insert "Error: ") + (insert-file-contents dired-async-log-file) + (delete-file dired-async-log-file)) + (run-with-timer + 0.1 nil + dired-async-message-function "Asynchronous %s of %s file(s) on %s file(s) done" + (car dired-async-operation) (cadr dired-async-operation) len-flist)))) + +(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)))))) + +(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 dired-async-operation nil) + (let (dired-create-files-failures + failures async-fn-list + skipped (success-count 0) + (total (length fn-list)) + callback) + (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))) + (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" + operation from to))) + (push (cons from to) async-fn-list))))) + (setq callback + `(lambda (&optional ignore) + (dired-async-after-file-create ,total) + (when (string= ,(downcase operation) "rename") + (cl-loop for (file . to) in ',async-fn-list + do (and (get-file-buffer file) + (with-current-buffer (get-file-buffer file) + (set-visited-file-name to nil t)))))))) + ;; Handle error happening in host emacs. + (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: %s file%s" + operation success-count (dired-plural-s success-count)))) + ;; 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) + (condition-case err + (let ((dired-recursive-copies (quote always))) + (cl-loop for (f . d) in (quote ,async-fn-list) + do (funcall (quote ,file-creator) f d t))) + (file-error + (with-temp-file ,dired-async-log-file + (insert (format "%S" err))))) + ,(dired-async-maybe-kill-ftp)) + callback) + ;; Run mode-line notifications while process running. + (dired-async--modeline-mode 1) + (setq dired-async-operation (list operation (length async-fn-list))) + (message "%s proceeding asynchronously..." operation)))) + +(defadvice dired-create-files (around dired-async) + (dired-async-create-files file-creator operation fn-list + name-constructor marker-char)) + +;;;###autoload +(define-minor-mode dired-async-mode + "Do dired actions asynchronously." + :group 'dired-async + :global t + (if dired-async-mode + (if (fboundp 'advice-add) + (advice-add 'dired-create-files :override #'dired-async-create-files) + (ad-activate 'dired-create-files)) + (if (fboundp 'advice-remove) + (advice-remove 'dired-create-files #'dired-async-create-files) + (ad-deactivate 'dired-create-files)))) + + +(provide 'dired-async) + +;;; dired-async.el ends here diff --git a/elpa/async-20151123.256/smtpmail-async.el b/elpa/async-20151123.256/smtpmail-async.el new file mode 100644 index 00000000..99c4017b --- /dev/null +++ b/elpa/async-20151123.256/smtpmail-async.el @@ -0,0 +1,73 @@ +;;; smtpmail-async.el --- Send e-mail with smtpmail.el asynchronously + +;; Copyright (C) 2012~2014 John Wiegley + +;; Author: John Wiegley +;; 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" + 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 diff --git a/elpa/async-readme.txt b/elpa/async-readme.txt new file mode 100644 index 00000000..3e6a4fef --- /dev/null +++ b/elpa/async-readme.txt @@ -0,0 +1,3 @@ +Adds the ability to call asynchronous functions and process with ease. See +the documentation for `async-start' and `async-start-process'. +