#+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)
)
)
#+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
+++ /dev/null
-;;; async-autoloads.el --- automatically extracted autoloads
-;;
-;;; Code:
-(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
-\f
-;;;### (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)
-
-;;;***
-\f
-;;;### (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)
-
-;;;***
-\f
-;;;### (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)
-
-;;;***
-\f
-;;;### (autoloads nil nil ("async-pkg.el" "smtpmail-async.el") (21908
-;;;;;; 14300 316611 0))
-
-;;;***
-\f
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; End:
-;;; async-autoloads.el ends here
+++ /dev/null
-;;; async-bytecomp.el --- Async functions to compile elisp files async
-
-;; Copyright (C) 2014 John Wiegley
-;; Copyright (C) 2014 Thierry Volpiatto
-
-;; Authors: John Wiegley <jwiegleyNOSPAMgmail.com>
-;; Thierry Volpiatto <thierry.volpiattoNOSPAMgmail.com>
-
-;; 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
+++ /dev/null
-(define-package "async" "20150529.529" "Asynchronous processing in Emacs" 'nil)
-;; Local Variables:
-;; no-byte-compile: t
-;; End:
+++ /dev/null
-;;; async --- Asynchronous processing in Emacs
-
-;; Copyright (C) 2012~2014 John Wiegley
-
-;; Author: John Wiegley <jwiegleyNOSPAMgmail.com>
-;; 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.
-\f
-;;; Commentary:
-
-;; Adds the ability to call asynchronous functions and process with ease. See
-;; the documentation for `async-start' and `async-start-process'.
-\f
-;;; 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
- "<none>"
- (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
+++ /dev/null
-;;; dired-async.el --- Copy/move/delete asynchronously in dired.
-
-;; Copyright (C) 2012~2014 John Wiegley
-;; Copyright (C) 2012~2014 Thierry Volpiatto
-
-;; Authors: John Wiegley <jwiegleyNOSPAMgmail.com>
-;; Thierry Volpiatto <thierry.volpiattoNOSPAMgmail.com>
-
-;; 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.
-\f
-;;; 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:
-\f
-(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
+++ /dev/null
-;;; smtpmail-async --- Send e-mail with smtpmail.el asynchronously
-
-;; Copyright (C) 2012~2014 John Wiegley
-
-;; Author: John Wiegley <jwiegleyNOSPAMgmail.com>
-;; 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.
-\f
-;;; 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
--- /dev/null
+;;; async-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
+\f
+;;;### (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)
+
+;;;***
+\f
+;;;### (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)
+
+;;;***
+\f
+;;;### (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)
+
+;;;***
+\f
+;;;### (autoloads nil nil ("async-pkg.el" "smtpmail-async.el") (22140
+;;;;;; 8226 463061 0))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; End:
+;;; async-autoloads.el ends here
--- /dev/null
+;;; async-bytecomp.el --- Async functions to compile elisp files async
+
+;; Copyright (C) 2014 John Wiegley
+;; Copyright (C) 2014 Thierry Volpiatto
+
+;; Authors: John Wiegley <jwiegleyNOSPAMgmail.com>
+;; Thierry Volpiatto <thierry.volpiattoNOSPAMgmail.com>
+
+;; 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
--- /dev/null
+(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:
--- /dev/null
+;;; async.el --- Asynchronous processing in Emacs
+
+;; Copyright (C) 2012~2014 John Wiegley
+
+;; Author: John Wiegley <jwiegleyNOSPAMgmail.com>
+;; 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.
+\f
+;;; Commentary:
+
+;; Adds the ability to call asynchronous functions and process with ease. See
+;; the documentation for `async-start' and `async-start-process'.
+\f
+;;; 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
+ "<none>"
+ (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
--- /dev/null
+;;; dired-async.el --- Copy/move/delete asynchronously in dired.
+
+;; Copyright (C) 2012~2014 John Wiegley
+;; Copyright (C) 2012~2014 Thierry Volpiatto
+
+;; Authors: John Wiegley <jwiegleyNOSPAMgmail.com>
+;; Thierry Volpiatto <thierry.volpiattoNOSPAMgmail.com>
+
+;; 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.
+\f
+;;; 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:
+\f
+(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
--- /dev/null
+;;; smtpmail-async.el --- Send e-mail with smtpmail.el asynchronously
+
+;; Copyright (C) 2012~2014 John Wiegley
+
+;; Author: John Wiegley <jwiegleyNOSPAMgmail.com>
+;; 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.
+\f
+;;; 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
--- /dev/null
+Adds the ability to call asynchronous functions and process with ease. See
+the documentation for `async-start' and `async-start-process'.
+\f
projects / emacsconfig.git / commitdiff