Nicolas Goaziou writes: > `org-babel--suppress-confirm-evaluate-answer-no' to t from > `org-export-async-start'. I would suggest a shorter variable name,
I've dropped the "suppress-" as it is redundant, but kept the "confirm-evaluate". >> -;;; ob-core.el --- working with code blocks in org-mode >> +;; ob-core.el --- working with code blocks in org-mode > > You should leave 3 semicolons. This is standard elisp library starter. That was an accident. > I would refactor it like the following: > > (org-babel--check-confirm-evaluate info > (or (equal eval "never") (equal eval "no") > (and (org-bound-and-true-p org-current-export-file) > (or (equal eval "no-export") (equal eval "never-export"))) > (prog1 nil (message (format "Evaluation of this%scode block%sis > disabled." > code-block block-name))))) I wouldn't, it reverses the logic of that function. Most of the code was copied from the original function and I had originally intended to adhere closely to that so Eric has an easier time to tell whether this is good or not. Anyway, I've had a go at this, not sure if it is much better than the original. The logic in these functions is a bit convoluted, after all.
>From 85ab6e8a2c81aad038b55350d6996035aaca3763 Mon Sep 17 00:00:00 2001 From: Achim Gratz <strom...@stromeko.de> Date: Wed, 27 Feb 2013 22:55:26 +0100 Subject: [PATCH] ob-core: do not ask for confirmation if cached result is current MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/ob-core.el (org-babel-confirm-evaluate): Remove this internal function and replace with `org-babel--check-evaluate´ and `org-babel--confirm-evaluate´. * lisp/ob-core.el (org-babel--check-confirm-evaluate): New macro to ensure that the initial let-bindings for `org-babel--check-evaluate´ and `org-babel--confirm-evaluate´ are consistent. * lisp/ob-core.el (org-babel--check-evaluate): First part of the original `org-babel-confirm-evaluate´, check whether this source block evaluation is enabled. * lisp/ob-core.el (org-babel--confirm-evaluate-answer-no): Dynamically scoped variable, if bound non-nil the confirmation dialog will not be initiated denial of evaluation is assumed. * lisp/ob-core.el (org-babel--confirm-evaluate): Second part of the original `org-babel-confirm-evaluate´, check if the user needs to be queried. If not, affirm evaluation, else check if evaluation should be auto-denied and lastly ask the user. * lisp/ob-core.el (org-babel-execute-src-block): Do not ask for confirmation if the cached result is current. The call to `org-babel--check-evaluate´ will indicate if the block should be evaluated. If yes, determine whether the cached result block is current (since `org-babel-process-params´ might trigger expensive operations this has to be deferred). If `cache-current-p´ is t, evaluate the source block without asking. In case the cache is current the evaluation will not actually do anything but return the cached value, so this is safe. Otherwise ask permission from the user by calling `org-babel--confirm-evaluate´ and act depending on the answer. The new variable `org-babel--confirm-evaluate-answer-no´ can be bound to suppress the user interaction as is needed for async export, as discussed in http://thread.gmane.org/gmane.emacs.orgmode/67719 --- lisp/ob-core.el | 204 +++++++++++++++++++++++++++++--------------------------- 1 file changed, 106 insertions(+), 98 deletions(-) diff --git a/lisp/ob-core.el b/lisp/ob-core.el index 3b7c463..7ac423b 100644 --- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -283,43 +283,50 @@ (defun org-babel-get-src-block-info (&optional light) (setf (nth 2 info) (org-babel-process-params (nth 2 info)))) (when info (append info (list name indent))))) -(defvar org-current-export-file) ; dynamically bound -(defun org-babel-confirm-evaluate (info) +(defvar org-current-export-file) ; dynamically scoped +(defmacro org-babel--check-confirm-evaluate (info &rest body) + "Pull some information from code block INFO and evaluate BODY." + (declare (indent defun)) + `(let* ((eval (or (cdr (assoc :eval (nth 2 ,info))) + (when (assoc :noeval (nth 2 ,info)) "no"))) + (code-block (if info (format " %s " (nth 0 ,info)) " ")) + (block-name (if (nth 4 ,info) (format " (%s) " (nth 4 ,info)) " "))) + ,@body)) +(defun org-babel--check-evaluate (info) + "Check whether the code block INFO should be evaluated." + (org-babel--check-confirm-evaluate info + (not (when (or (equal eval "never") (equal eval "no") + (and (org-bound-and-true-p org-current-export-file) + (or (equal eval "no-export") (equal eval "never-export")))) + (message (format "Evaluation of this%scode block%sis disabled." + code-block block-name)))))) +(defvar org-babel--confirm-evaluate-answer-no) ;; dynamically scoped +(defun org-babel--confirm-evaluate (info) "Confirm evaluation of the code block INFO. -This behavior can be suppressed by setting the value of + +If the variable `org-babel--confirm-evaluate-answer-no´ is bound +to a non-nil value, auto-answer with \"no\". + +This query can also be suppressed by setting the value of `org-confirm-babel-evaluate' to nil, in which case all future interactive code block evaluations will proceed without any confirmation from the user. Note disabling confirmation may result in accidental evaluation of potentially harmful code." - (let* ((eval (or (cdr (assoc :eval (nth 2 info))) - (when (assoc :noeval (nth 2 info)) "no"))) - (query (cond ((equal eval "query") t) - ((and (boundp 'org-current-export-file) - org-current-export-file - (equal eval "query-export")) t) - ((functionp org-confirm-babel-evaluate) - (funcall org-confirm-babel-evaluate - (nth 0 info) (nth 1 info))) - (t org-confirm-babel-evaluate)))) - (if (or (equal eval "never") (equal eval "no") - (and (boundp 'org-current-export-file) - org-current-export-file - (or (equal eval "no-export") - (equal eval "never-export"))) - (and query - (not (yes-or-no-p - (format "Evaluate this%scode block%son your system? " - (if info (format " %s " (nth 0 info)) " ") - (if (nth 4 info) - (format " (%s) " (nth 4 info)) " ")))))) - (prog1 nil (message "Evaluation %s" - (if (or (equal eval "never") (equal eval "no") - (equal eval "no-export") - (equal eval "never-export")) - "Disabled" "Aborted"))) - t))) + (org-babel--check-confirm-evaluate info + (not (when (cond ((equal eval "query") t) + ((and (org-bound-and-true-p org-current-export-file) + (equal eval "query-export")) t) + ((functionp org-confirm-babel-evaluate) + (funcall org-confirm-babel-evaluate + (nth 0 info) (nth 1 info))) + (t org-confirm-babel-evaluate)) + (or (org-bound-and-true-p org-babel--confirm-evaluate-answer-no) + (not (yes-or-no-p (format "Evaluate this%scode block%son your system? " + code-block block-name))) + (message (format "Evaluation of%scode-block%snot confirmed." + code-block block-name))))))) ;;;###autoload (defun org-babel-execute-safely-maybe () @@ -525,80 +532,81 @@ (defun org-babel-execute-src-block (&optional arg info params) (interactive) (let* ((info (or info (org-babel-get-src-block-info))) (merged-params (org-babel-merge-params (nth 2 info) params))) - (when (org-babel-confirm-evaluate + (when (org-babel--check-evaluate (let ((i info)) (setf (nth 2 i) merged-params) i)) - (let* ((lang (nth 0 info)) - (params (if params + (let* ((params (if params (org-babel-process-params merged-params) (nth 2 info))) (cache-p (and (not arg) (cdr (assoc :cache params)) - (string= "yes" (cdr (assoc :cache params))))) - (result-params (cdr (assoc :result-params params))) + (string= "yes" (cdr (assoc :cache params))))) (new-hash (when cache-p (org-babel-sha1-hash info))) (old-hash (when cache-p (org-babel-current-result-hash))) - (cache-current-p (and (not arg) new-hash (equal new-hash old-hash))) - (body (setf (nth 1 info) - (if (org-babel-noweb-p params :eval) - (org-babel-expand-noweb-references info) - (nth 1 info)))) - (dir (cdr (assoc :dir params))) - (default-directory - (or (and dir (file-name-as-directory (expand-file-name dir))) - default-directory)) - (org-babel-call-process-region-original - (if (boundp 'org-babel-call-process-region-original) - org-babel-call-process-region-original - (symbol-function 'call-process-region))) - (indent (car (last info))) - result cmd) - (unwind-protect - (let ((call-process-region - (lambda (&rest args) - (apply 'org-babel-tramp-handle-call-process-region args)))) - (let ((lang-check (lambda (f) - (let ((f (intern (concat "org-babel-execute:" f)))) - (when (fboundp f) f))))) - (setq cmd - (or (funcall lang-check lang) - (funcall lang-check (symbol-name - (cdr (assoc lang org-src-lang-modes)))) - (error "No org-babel-execute function for %s!" lang)))) - (if cache-current-p - (save-excursion ;; return cached result - (goto-char (org-babel-where-is-src-block-result nil info)) - (end-of-line 1) (forward-char 1) - (setq result (org-babel-read-result)) - (message (replace-regexp-in-string - "%" "%%" (format "%S" result))) result) - (message "executing %s code block%s..." - (capitalize lang) - (if (nth 4 info) (format " (%s)" (nth 4 info)) "")) - (if (member "none" result-params) - (progn - (funcall cmd body params) - (message "result silenced")) - (setq result - ((lambda (result) - (if (and (eq (cdr (assoc :result-type params)) 'value) - (or (member "vector" result-params) - (member "table" result-params)) - (not (listp result))) - (list (list result)) result)) - (funcall cmd body params))) - ;; if non-empty result and :file then write to :file - (when (cdr (assoc :file params)) - (when result - (with-temp-file (cdr (assoc :file params)) - (insert - (org-babel-format-result - result (cdr (assoc :sep (nth 2 info))))))) - (setq result (cdr (assoc :file params)))) - (org-babel-insert-result - result result-params info new-hash indent lang) - (run-hooks 'org-babel-after-execute-hook) - result - ))) - (setq call-process-region 'org-babel-call-process-region-original)))))) + (cache-current-p (and (not arg) new-hash (equal new-hash old-hash)))) + (when (or cache-current-p + (org-babel--confirm-evaluate + (let ((i info)) (setf (nth 2 i) merged-params) i))) + (let* ((lang (nth 0 info)) + (result-params (cdr (assoc :result-params params))) + (body (setf (nth 1 info) + (if (org-babel-noweb-p params :eval) + (org-babel-expand-noweb-references info) + (nth 1 info)))) + (dir (cdr (assoc :dir params))) + (default-directory + (or (and dir (file-name-as-directory (expand-file-name dir))) + default-directory)) + (org-babel-call-process-region-original + (if (org-bound-and-true-p org-babel-call-process-region-original) + (symbol-function 'call-process-region))) + (indent (car (last info))) + result cmd) + (unwind-protect + (let ((call-process-region + (lambda (&rest args) + (apply 'org-babel-tramp-handle-call-process-region args)))) + (let ((lang-check (lambda (f) + (let ((f (intern (concat "org-babel-execute:" f)))) + (when (fboundp f) f))))) + (setq cmd + (or (funcall lang-check lang) + (funcall lang-check (symbol-name + (cdr (assoc lang org-src-lang-modes)))) + (error "No org-babel-execute function for %s!" lang)))) + (if cache-current-p + (save-excursion ;; return cached result + (goto-char (org-babel-where-is-src-block-result nil info)) + (end-of-line 1) (forward-char 1) + (setq result (org-babel-read-result)) + (message (replace-regexp-in-string + "%" "%%" (format "%S" result))) result) + (message "executing %s code block%s..." + (capitalize lang) + (if (nth 4 info) (format " (%s)" (nth 4 info)) "")) + (if (member "none" result-params) + (progn + (funcall cmd body params) + (message "result silenced")) + (setq result + ((lambda (result) + (if (and (eq (cdr (assoc :result-type params)) 'value) + (or (member "vector" result-params) + (member "table" result-params)) + (not (listp result))) + (list (list result)) result)) + (funcall cmd body params))) + ;; if non-empty result and :file then write to :file + (when (cdr (assoc :file params)) + (when result + (with-temp-file (cdr (assoc :file params)) + (insert + (org-babel-format-result + result (cdr (assoc :sep (nth 2 info))))))) + (setq result (cdr (assoc :file params)))) + (org-babel-insert-result + result result-params info new-hash indent lang) + (run-hooks 'org-babel-after-execute-hook) + result))) + (setq call-process-region 'org-babel-call-process-region-original)))))))) (defun org-babel-expand-body:generic (body params &optional var-lines) "Expand BODY with PARAMS. -- 1.8.1.4
Regards, Achim. -- +<[Q+ Matrix-12 WAVE#46+305 Neuron microQkb Andromeda XTk Blofeld]>+ Factory and User Sound Singles for Waldorf Q+, Q and microQ: http://Synth.Stromeko.net/Downloads.html#WaldorfSounds
