diff options
author | Achim Gratz <Stromeko@Stromeko.DE> | 2013-03-09 01:34:09 +0100 |
---|---|---|
committer | Achim Gratz <Stromeko@Stromeko.DE> | 2013-03-09 21:33:19 +0100 |
commit | be0883940d9fdb379d02a545c9a0d67f06b38ea1 (patch) | |
tree | 9d624ec3c6f63fd0e780ae0442b682e16139d1bb | |
parent | 5fe486807e618029dda041300855ef6e3c6a7626 (diff) | |
download | org-mode-be0883940d9fdb379d02a545c9a0d67f06b38ea1.tar.gz |
ob-core: refactor org-babel-confirm-evaluate, do not confirm evaluation if cache is current
* lisp/ob-core.el (org-babel-check-confirm-evaluate): New macro to
establish bindings based on INFO.
* lisp/ob-core.el (org-babel-check-evaluate): New defsubst that checks
if the evaluation of a code block is disabled. Refactors the first
part of the original function `org-babel-confirm-evaluateĀ“.
* lisp/ob-core.el (org-babel-confirm-evaluate): New defsubst that
checks if the user should be queried and returns the answer. Keeps
the second part of the original function `org-babel-confirm-evaluateĀ“.
* lisp/ob-core.el (org-babel-execute-src-block): Do not ask for
confirmation if the cached result is current.
-rw-r--r-- | lisp/ob-core.el | 202 |
1 files changed, 106 insertions, 96 deletions
diff --git a/lisp/ob-core.el b/lisp/ob-core.el index f8ca04f..c6695b9 100644 --- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -285,7 +285,37 @@ Returns a list (when info (append info (list name indent))))) (defvar org-current-export-file) ; dynamically bound -(defun org-babel-confirm-evaluate (info) +(defmacro org-babel-check-confirm-evaluate (info &rest body) + "Pull some information from code block INFO and evaluate BODY." + (declare (indent defun)) + `(let* ((info0th (nth 0 ,info)) + (info1st (nth 1 ,info)) + (info2nd (nth 2 ,info)) + (info4th (nth 4 ,info)) + (eval (or (cdr (assoc :eval info2nd)) + (when (assoc :noeval info2nd) "no"))) + (eval-no (or (equal eval "no") + (equal eval "never"))) + (export (org-bound-and-true-p org-current-export-file)) + (eval-no-export (and export (or (equal eval "no-export") + (equal eval "never-export")))) + (noeval (or eval-no eval-no-export)) + (query (or (equal eval "query") + (and export (equal eval "query-export")) + (when (functionp org-confirm-babel-evaluate) + (funcall org-confirm-babel-evaluate info0th info1st)) + org-confirm-babel-evaluate)) + (code-block (if info (format " %s " info0th) " ")) + (block-name (if info4th (format " (%s) " info4th) " "))) + ,@body)) +(defsubst org-babel-check-evaluate (info) + "Check if code block INFO should be evaluated. +Do not query the user." + (org-babel-check-confirm-evaluate info + (not (when noeval + (message (format "Evaluation of this%scode-block%sis disabled." + code-block block-name)))))) +(defsubst org-babel-confirm-evaluate (info) "Confirm evaluation of the code block INFO. This behavior can be suppressed by setting the value of `org-confirm-babel-evaluate' to nil, in which case all future @@ -294,33 +324,12 @@ confirmation from the user. Note disabling confirmation may result in accidental evaluation of potentially harmful code." - (let* ((info0th (nth 0 info)) - (info1st (nth 1 info)) - (info2nd (nth 2 info)) - (info4th (nth 4 info)) - (eval (or (cdr (assoc :eval info2nd)) - (when (assoc :noeval info2nd) "no"))) - (eval-no (or (equal eval "no") - (equal eval "never"))) - (export (org-bound-and-true-p org-current-export-file)) - (eval-no-export (and export (or (equal eval "no-export") - (equal eval "never-export")))) - (noeval (or eval-no eval-no-export)) - (query (or (equal eval "query") - (and export (equal eval "query-export")) - (when (functionp org-confirm-babel-evaluate) - (funcall org-confirm-babel-evaluate info0th info1st)) - org-confirm-babel-evaluate)) - (code-block (if info (format " %s " info0th) " ")) - (block-name (if info4th (format " (%s) " info4th) " "))) - (if (or noeval - (and query - (not (yes-or-no-p (format "Evaluate this%scode block%son your system? " - code-block block-name))))) - (prog1 nil - (message (format "Evaluation of this%scode-block%sis %s." - code-block block-name (if noeval "disabled" "aborted")))) - t))) + (org-babel-check-confirm-evaluate info + (not (when query + (unless (yes-or-no-p (format "Evaluate this%scode block%son your system? " + code-block block-name)) + (message (format "Evaluation of this%scode-block%sis aborted." + code-block block-name))))))) ;;;###autoload (defun org-babel-execute-safely-maybe () @@ -526,80 +535,81 @@ block." (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 ;; for tramp handler + (or (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. |