;;; ob-async.el --- Asynchronous org-babel src block execution ;; Copyright (C) 2017 Andrew Stahlman ;; Author: Andrew Stahlman ;; Created: 10 Feb 2017 ;; Package-Version: 20210428.2052 ;; Package-Revision: 9aac486073f5 ;; Keywords: tools ;; Homepage: https://github.com/astahlman/ob-async ;; This file is not part of GNU Emacs. ;; 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 3 of the License, 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 this program. If not, see . ;; Package-Requires: ((async "1.9") (org "9.0.1") (emacs "24.4") (dash "2.14.1")) ;;; Commentary: ;; This file enables asynchronous execution of org-babel ;; src blocks through the ob-async-org-babel-execute-src-block function ;;; Code: (provide 'ob-async) (require 'org) (require 'async) (require 'dash) (defvar ob-async-no-async-languages-alist nil "async is not used for languages listed here. Enables compatibility for other languages, e.g. ipython, for which async functionality may be implemented separately.") (defvar ob-async-pre-execute-src-block-hook nil "Hook run in the async child process prior to executing a src block. You can use this hook to perform language-specific initialization which would normally execute in your init file.") (defvar ob-async-inject-variables "\\borg-babel.+" "Regex of variables that should be injected into the async process. It's a good idea to include any variables that are prefixed with `org-babel'. Add additional variables like \"\\(\\borg-babel.+\\|sql-connection-alist\\)\".") ;;;###autoload (defalias 'org-babel-execute-src-block:async 'ob-async-org-babel-execute-src-block) ;;;###autoload (defun ob-async-org-babel-execute-src-block (&optional orig-fun arg info params) "Like org-babel-execute-src-block, but run asynchronously. Original docstring for org-babel-execute-src-block: Execute the current source code block. Insert the results of execution into the buffer. Source code execution and the collection and formatting of results can be controlled through a variety of header arguments. With prefix argument ARG, force re-execution even if an existing result cached in the buffer would otherwise have been returned. Optionally supply a value for INFO in the form returned by `org-babel-get-src-block-info'. Optionally supply a value for PARAMS which will be merged with the header arguments specified at the front of the source code block." (interactive "P") (cond ;; If this function is not called as advice, do nothing ((not orig-fun) (warn "ob-async-org-babel-execute-src-block is no longer needed in org-ctrl-c-ctrl-c-hook") nil) ;; If there is no :async parameter, call the original function ((not (assoc :async (nth 2 (or info (org-babel-get-src-block-info))))) (funcall orig-fun arg info params)) ;; If the src block language is in the list of languages async is not to be ;; used for, call the original function ((member (nth 0 (or info (org-babel-get-src-block-info))) ob-async-no-async-languages-alist) (funcall orig-fun arg info params)) ;; Otherwise, perform asynchronous execution (t (let ((placeholder (ob-async--generate-uuid))) ;; Here begins the original source of org-babel-execute-src-block (let* ((org-babel-current-src-block-location (or org-babel-current-src-block-location (nth 5 info) (org-babel-where-is-src-block-head))) (src-block-marker (save-excursion (goto-char org-babel-current-src-block-location) (point-marker))) (info (if info (copy-tree info) (org-babel-get-src-block-info)))) ;; Merge PARAMS with INFO before considering source block ;; evaluation since both could disagree. (cl-callf org-babel-merge-params (nth 2 info) params) (when (org-babel-check-evaluate info) (cl-callf org-babel-process-params (nth 2 info)) (let* ((params (nth 2 info)) (cache (let ((c (cdr (assq :cache params)))) (and (not arg) c (string= "yes" c)))) (new-hash (and cache (org-babel-sha1-hash info))) (old-hash (and cache (org-babel-current-result-hash))) (current-cache (and new-hash (equal new-hash old-hash))) (result-params (cdr (assq :result-params params)))) (cond (current-cache (save-excursion ;Return cached result. (goto-char (org-babel-where-is-src-block-result nil info)) (forward-line) (skip-chars-forward " \t") (let ((result (org-babel-read-result))) (message (replace-regexp-in-string "%" "%%" (format "%S" result))) result))) ((org-babel-confirm-evaluate info) ;; Insert a GUID as a placeholder in our RESULTS block (when (not (or (member "none" result-params) (member "silent" result-params))) (org-babel-insert-result placeholder '("replace"))) (let* ((lang (nth 0 info)) ;; Expand noweb references in BODY and remove any ;; coderef. (body (let ((coderef (nth 6 info)) (expand (if (org-babel-noweb-p params :eval) (org-babel-expand-noweb-references info) (nth 1 info)))) (if (not coderef) expand (replace-regexp-in-string (org-src-coderef-regexp coderef) "" expand nil nil 1)))) (dir (cdr (assq :dir params))) (default-directory (or (and dir (file-name-as-directory (expand-file-name dir))) default-directory)) (cmd (intern (concat "org-babel-execute:" lang))) (org-babel-async-content (buffer-substring-no-properties (point-min) (point-max))) result) (unless (fboundp cmd) (error "No org-babel-execute function for %s!" lang)) (message "executing %s code block%s..." (capitalize lang) (let ((name (nth 4 info))) (if name (format " (%s)" name) ""))) (progn (async-start `(lambda () ;; TODO: Put this in a function so it can be overidden ;; Initialize the new Emacs process with org-babel functions (setq exec-path ',exec-path) (setq load-path ',load-path) ,(async-inject-variables ob-async-inject-variables) (package-initialize) (setq ob-async-pre-execute-src-block-hook ',ob-async-pre-execute-src-block-hook) (run-hooks 'ob-async-pre-execute-src-block-hook) (org-babel-do-load-languages 'org-babel-load-languages ',org-babel-load-languages) (let ((default-directory ,default-directory)) (with-temp-buffer (insert org-babel-async-content) (,cmd ,body ',params)))) `(lambda (result) (with-current-buffer ,(current-buffer) (let ((default-directory ,default-directory)) (save-excursion (cond ((member "none" ',result-params) (message "result silenced")) ((member "silent" ',result-params) (message (replace-regexp-in-string "%" "%%" (format "%S" result)))) (t (goto-char ,src-block-marker) (let ((file (cdr (assq :file ',params)))) (when file ;; when result type is link, don't write result content to file. (unless (member "link" ',result-params) ;; If non-empty result and :file then write to :file. (when result (with-temp-file file (insert (org-babel-format-result result (cdr (assq :sep ',params))))))) (setq result file)) ;; Possibly perform post process provided its ;; appropriate. Dynamically bind "*this*" to the ;; actual results of the block. (let ((post (cdr (assq :post ',params)))) (when post (let ((*this* (if (not file) result (org-babel-result-to-file file (let ((desc (assq :file-desc ',params))) (and desc (or (cdr desc) result))))))) (setq result (org-babel-ref-resolve post)) (when file (setq result-params (remove "file" ',result-params)))))) (org-babel-insert-result result ',result-params ',info ',new-hash ',lang)))) (run-hooks 'org-babel-after-execute-hook))))))))))))))))) (defun ob-async--generate-uuid () "Generate a 32 character UUID." (md5 (number-to-string (random 100000000)))) (advice-add 'org-babel-execute-src-block :around 'ob-async-org-babel-execute-src-block) ;;; ob-async.el ends here