diff options
Diffstat (limited to 'lisp/ob-core.el')
| -rw-r--r-- | lisp/ob-core.el | 972 |
1 files changed, 650 insertions, 322 deletions
diff --git a/lisp/ob-core.el b/lisp/ob-core.el index eef408f..30020f7 100644 --- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -1,6 +1,6 @@ ;;; ob-core.el --- working with code blocks in org-mode -;; Copyright (C) 2009-2014 Free Software Foundation, Inc. +;; Copyright (C) 2009-2015 Free Software Foundation, Inc. ;; Authors: Eric Schulte ;; Dan Davison @@ -39,6 +39,7 @@ (defvar org-babel-library-of-babel) (declare-function show-all "outline" ()) (declare-function org-every "org" (pred seq)) +(declare-function org-remove-indentation "org" (code &optional n)) (declare-function org-reduce "org" (CL-FUNC CL-SEQ &rest CL-KEYS)) (declare-function org-mark-ring-push "org" (&optional pos buffer)) (declare-function tramp-compat-make-temp-file "tramp-compat" @@ -48,9 +49,8 @@ (declare-function tramp-file-name-host "tramp" (vec)) (declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body)) (declare-function org-icompleting-read "org" (&rest args)) -(declare-function org-edit-src-code "org-src" - (&optional context code edit-buffer-name quietp)) -(declare-function org-edit-src-exit "org-src" (&optional context)) +(declare-function org-edit-src-code "org-src" (&optional code edit-buffer-name)) +(declare-function org-edit-src-exit "org-src" ()) (declare-function org-open-at-point "org" (&optional in-emacs reference-buffer)) (declare-function org-save-outline-visibility "org-macs" (use-markers &rest body)) (declare-function org-outline-overlay-data "org" (&optional use-markers)) @@ -96,7 +96,12 @@ (declare-function org-unescape-code-in-string "org-src" (s)) (declare-function org-table-to-lisp "org-table" (&optional txt)) (declare-function org-reverse-string "org" (string)) -(declare-function org-element-context "org-element" (&optional ELEMENT)) +(declare-function org-element-context "org-element" (&optional element)) +(declare-function org-element-type "org-element" (element)) +(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-every "org" (pred seq)) +(declare-function org-macro-escape-arguments "org-macro" (&rest args)) (defgroup org-babel nil "Code block evaluation and management in `org-mode' documents." @@ -135,12 +140,16 @@ remove code block execution from the C-c C-c keybinding." (defcustom org-babel-results-keyword "RESULTS" "Keyword used to name results generated by code blocks. -Should be either RESULTS or NAME however any capitalization may -be used." +It should be \"RESULTS\". However any capitalization may be +used." :group 'org-babel :version "24.4" :package-version '(Org . "8.0") - :type 'string) + :type 'string + :safe (lambda (v) + (and (stringp v) + (eq (compare-strings "RESULTS" nil nil v nil nil t) + t)))) (defcustom org-babel-noweb-wrap-start "<<" "String used to begin a noweb reference in a code block. @@ -159,6 +168,11 @@ See also `org-babel-noweb-wrap-start'." This string must include a \"%s\" which will be replaced by the results." :group 'org-babel :type 'string) +(put 'org-babel-inline-result-wrap + 'safe-local-variable + (lambda (value) + (and (stringp value) + (string-match-p "%s" value)))) (defun org-babel-noweb-wrap (&optional regexp) (concat org-babel-noweb-wrap-start @@ -173,14 +187,6 @@ This string must include a \"%s\" which will be replaced by the results." "^[ \t]*#\\+headers?:[ \t]*\\([^\n]*\\)$" "Regular expression used to match multi-line header arguments.") -(defvar org-babel-src-name-w-name-regexp - (concat org-babel-src-name-regexp - "\\(" - org-babel-multi-line-header-regexp - "\\)*" - "\\([^ ()\f\t\n\r\v]+\\)") - "Regular expression matching source name lines with a name.") - (defvar org-babel-src-block-regexp (concat ;; (1) indentation (2) lang @@ -196,9 +202,9 @@ This string must include a \"%s\" which will be replaced by the results." (defvar org-babel-inline-src-block-regexp (concat ;; (1) replacement target (2) lang - "\\(?:^\\|[^-[:alnum:]]\\)\\(src_\\([^ \f\t\n\r\v]+\\)" + "\\(?:^\\|[^-[:alnum:]]?\\)\\(src_\\([^ \f\t\n\r\v[]+\\)" ;; (3,4) (unused, headers) - "\\(\\|\\[\\(.*?\\)\\]\\)" + "\\(\\|\\[[ \t]*\\(.*?\\)\\]\\)" ;; (5) body "{\\([^\f\n\r\v]+?\\)}\\)") "Regexp used to identify inline src-blocks.") @@ -212,35 +218,24 @@ not match KEY should be returned." (lambda (p) (when (funcall (if others #'not #'identity) (eq (car p) key)) p)) params))) -(defun org-babel-get-inline-src-block-matches() +(defun org-babel-get-inline-src-block-matches () "Set match data if within body of an inline source block. Returns non-nil if match-data set" - (let ((src-at-0-p (save-excursion - (beginning-of-line 1) - (string= "src" (thing-at-point 'word)))) - (first-line-p (= (line-beginning-position) (point-min))) - (orig (point))) - (let ((search-for (cond ((and src-at-0-p first-line-p "src_")) - (first-line-p "[[:punct:] \t]src_") - (t "[[:punct:] \f\t\n\r\v]src_"))) - (lower-limit (if first-line-p - nil - (- (point-at-bol) 1)))) - (save-excursion - (when (or (and src-at-0-p (bobp)) - (and (re-search-forward "}" (point-at-eol) t) - (re-search-backward search-for lower-limit t) - (> orig (point)))) - (when (looking-at org-babel-inline-src-block-regexp) - t )))))) + (save-excursion + (let ((datum (org-element-context))) + (when (eq (org-element-type datum) 'inline-src-block) + (goto-char (org-element-property :begin datum)) + (when (looking-at org-babel-inline-src-block-regexp) + t ))))) (defvar org-babel-inline-lob-one-liner-regexp) -(defun org-babel-get-lob-one-liner-matches() +(defun org-babel-get-lob-one-liner-matches () "Set match data if on line of an lob one liner. Returns non-nil if match-data set" (save-excursion - (unless (= (point) (point-at-bol)) ;; move before inline block - (re-search-backward "[ \f\t\n\r\v]" nil t)) + (let ((datum (org-element-context))) + (when (eq (org-element-type datum) 'inline-babel-call) + (goto-char (org-element-property :begin datum)))) (if (looking-at org-babel-inline-lob-one-liner-regexp) t nil))) @@ -268,17 +263,24 @@ Returns a list (org-babel-merge-params (nth 2 info) (org-babel-parse-header-arguments (match-string 1))))) - (when (looking-at org-babel-src-name-w-name-regexp) - (setq name (org-no-properties (match-string 3))))) + (when (looking-at (org-babel-named-src-block-regexp-for-name)) + (setq name (org-match-string-no-properties 9)))) ;; inline source block (when (org-babel-get-inline-src-block-matches) + (setq head (match-beginning 0)) (setq info (org-babel-parse-inline-src-block-match)))) ;; resolve variable references and add summary parameters (when (and info (not light)) (setf (nth 2 info) (org-babel-process-params (nth 2 info)))) + (when info + (setf (nth 2 info) (org-babel-generate-file-param name (nth 2 info)))) (when info (append info (list name indent head))))) -(defvar org-current-export-file) ; dynamically bound +(defvar org-babel-exp-reference-buffer nil + "Buffer containing original contents of the exported buffer. +This is used by Babel to resolve references in source blocks. +Its value is dynamically bound during export.") + (defmacro org-babel-check-confirm-evaluate (info &rest body) "Evaluate BODY with special execution confirmation variables set. @@ -288,24 +290,27 @@ hold the language of the code block, and BLOCK-NAME will hold the name of the code block." (declare (indent defun)) (org-with-gensyms - (lang block-body headers name eval eval-no export eval-no-export) + (lang block-body headers name head eval eval-no export eval-no-export) `(let* ((,lang (nth 0 ,info)) (,block-body (nth 1 ,info)) (,headers (nth 2 ,info)) (,name (nth 4 ,info)) + (,head (nth 6 ,info)) (,eval (or (cdr (assoc :eval ,headers)) (when (assoc :noeval ,headers) "no"))) (,eval-no (or (equal ,eval "no") (equal ,eval "never"))) - (,export (org-bound-and-true-p org-current-export-file)) + (,export org-babel-exp-reference-buffer) (,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")) (if (functionp org-confirm-babel-evaluate) - (funcall org-confirm-babel-evaluate - ,lang ,block-body) + (save-excursion + (goto-char ,head) + (funcall org-confirm-babel-evaluate + ,lang ,block-body)) org-confirm-babel-evaluate))) (code-block (if ,info (format " %s " ,lang) " ")) (block-name (if ,name (format " (%s) " ,name) " "))) @@ -396,12 +401,16 @@ a window into the `org-babel-get-src-block-info' function." (header-args (nth 2 info))) (when name (funcall printf "Name: %s\n" name)) (when lang (funcall printf "Lang: %s\n" lang)) + (funcall printf "Properties:\n") + (funcall printf "\t:header-args \t%s\n" (org-entry-get (point) "header-args" t)) + (funcall printf "\t:header-args:%s \t%s\n" lang (org-entry-get (point) (concat "header-args:" lang) t)) + (when (funcall full switches) (funcall printf "Switches: %s\n" switches)) (funcall printf "Header Arguments:\n") (dolist (pair (sort header-args (lambda (a b) (string< (symbol-name (car a)) (symbol-name (car b)))))) - (when (funcall full (cdr pair)) + (when (funcall full (format "%s" (cdr pair))) (funcall printf "\t%S%s\t%s\n" (car pair) (if (> (length (format "%S" (car pair))) 7) "" "\t") @@ -444,11 +453,13 @@ then run `org-babel-switch-to-session'." (colnames . ((nil no yes))) (comments . ((no link yes org both noweb))) (dir . :any) - (eval . ((never query))) + (eval . ((yes no no-export strip-export never-export eval never + query))) (exports . ((code results both none))) (epilogue . :any) (file . :any) (file-desc . :any) + (file-ext . :any) (hlines . ((no yes))) (mkdirp . ((yes no))) (no-expand) @@ -456,6 +467,7 @@ then run `org-babel-switch-to-session'." (noweb . ((yes no tangle no-export strip-export))) (noweb-ref . :any) (noweb-sep . :any) + (output-dir . :any) (padline . ((yes no))) (post . :any) (prologue . :any) @@ -478,14 +490,55 @@ then run `org-babel-switch-to-session'." Note that individual languages may define their own language specific header arguments as well.") +(defconst org-babel-safe-header-args + '(:cache :colnames :comments :exports :epilogue :hlines :noeval + :noweb :noweb-ref :noweb-sep :padline :prologue :rownames + :sep :session :tangle :wrap + (:eval . ("never" "query")) + (:results . (lambda (str) (not (string-match "file" str))))) + "A list of safe header arguments for babel source blocks. + +The list can have entries of the following forms: +- :ARG -> :ARG is always a safe header arg +- (:ARG . (VAL1 VAL2 ...)) -> :ARG is safe as a header arg if it is + `equal' to one of the VALs. +- (:ARG . FN) -> :ARG is safe as a header arg if the function FN + returns non-nil. FN is passed one + argument, the value of the header arg + (as a string).") + +(defmacro org-babel-header-args-safe-fn (safe-list) + "Return a function that determines whether a list of header args are safe. + +Intended usage is: +\(put 'org-babel-default-header-args 'safe-local-variable + (org-babel-header-args-safe-p org-babel-safe-header-args) + +This allows org-babel languages to extend the list of safe values for +their `org-babel-default-header-args:foo' variable. + +For the format of SAFE-LIST, see `org-babel-safe-header-args'." + `(lambda (value) + (and (listp value) + (org-every + (lambda (pair) + (and (consp pair) + (org-babel-one-header-arg-safe-p pair ,safe-list))) + value)))) + (defvar org-babel-default-header-args '((:session . "none") (:results . "replace") (:exports . "code") (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no")) "Default arguments to use when evaluating a source block.") +(put 'org-babel-default-header-args 'safe-local-variable + (org-babel-header-args-safe-fn org-babel-safe-header-args)) (defvar org-babel-default-inline-header-args - '((:session . "none") (:results . "replace") (:exports . "results")) + '((:session . "none") (:results . "replace") + (:exports . "results") (:hlines . "yes")) "Default arguments to use when evaluating an inline source block.") +(put 'org-babel-default-inline-header-args 'safe-local-variable + (org-babel-header-args-safe-fn org-babel-safe-header-args)) (defvar org-babel-data-names '("tblname" "results" "name")) @@ -512,11 +565,17 @@ block. Otherwise the output is marked as literal by inserting colons at the starts of the lines. This variable only takes effect if the :results output option is in effect.") +(defvar org-babel-noweb-error-all-langs nil + "Raise errors when noweb references don't resolve. +Also see `org-babel-noweb-error-langs' to control noweb errors on +a language by language bases.") + (defvar org-babel-noweb-error-langs nil "Languages for which Babel will raise literate programming errors. List of languages for which errors should be raised when the source code block satisfying a noweb reference in this language -can not be resolved.") +can not be resolved. Also see `org-babel-noweb-error-all-langs' +to raise errors for all languages.") (defvar org-babel-hash-show 4 "Number of initial characters to show of a hidden results hash.") @@ -527,10 +586,15 @@ can not be resolved.") (defvar org-babel-after-execute-hook nil "Hook for functions to be called after `org-babel-execute-src-block'") -(defun org-babel-named-src-block-regexp-for-name (name) - "This generates a regexp used to match a src block named NAME." - (concat org-babel-src-name-regexp (regexp-quote name) - "[ \t(]*[\r\n]\\(?:^#.*[\r\n]\\)*" +(defun org-babel-named-src-block-regexp-for-name (&optional name) + "This generates a regexp used to match a src block named NAME. +If NAME is nil, match any name. Matched name is then put in +match group 9. Other match groups are defined in +`org-babel-src-block-regexp'." + (concat org-babel-src-name-regexp + (concat (if name (regexp-quote name) "\\(?9:.*?\\)") "[ \t]*" ) + "\\(?:\n[ \t]*#\\+\\S-+:.*\\)*?" + "\n" (substring org-babel-src-block-regexp 1))) (defun org-babel-named-data-regexp-for-name (name) @@ -566,7 +630,10 @@ block." (let* ((org-babel-current-src-block-location (or org-babel-current-src-block-location (nth 6 info) - (org-babel-where-is-src-block-head))) + (org-babel-where-is-src-block-head) + ;; inline src block + (and (org-babel-get-inline-src-block-matches) + (match-beginning 0)))) (info (if info (copy-tree info) (org-babel-get-src-block-info))) @@ -586,7 +653,8 @@ block." (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) + (forward-line) + (skip-chars-forward " \t") (let ((result (org-babel-read-result))) (message (replace-regexp-in-string "%" "%%" (format "%S" result))) result))) @@ -709,8 +777,7 @@ arguments and pop open the results in a preview buffer." (funcall assignments-cmd params)))))) (if (org-called-interactively-p 'any) (org-edit-src-code - nil expanded - (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*")) + expanded (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*")) expanded))) (defun org-babel-edit-distance (s1 s2) @@ -770,37 +837,43 @@ arguments and pop open the results in a preview buffer." (message "No suspicious header arguments found."))) ;;;###autoload -(defun org-babel-insert-header-arg () +(defun org-babel-insert-header-arg (&optional header-arg value) "Insert a header argument selecting from lists of common args and values." (interactive) - (let* ((lang (car (org-babel-get-src-block-info 'light))) + (let* ((info (org-babel-get-src-block-info 'light)) + (lang (car info)) + (begin (nth 6 info)) (lang-headers (intern (concat "org-babel-header-args:" lang))) (headers (org-babel-combine-header-arg-lists org-babel-common-header-args-w-values (when (boundp lang-headers) (eval lang-headers)))) - (arg (org-icompleting-read - "Header Arg: " - (mapcar - (lambda (header-spec) (symbol-name (car header-spec))) - headers)))) - (insert ":" arg) - (let ((vals (cdr (assoc (intern arg) headers)))) - (when vals - (insert - " " - (cond - ((eq vals :any) - (read-from-minibuffer "value: ")) - ((listp vals) - (mapconcat - (lambda (group) - (let ((arg (org-icompleting-read - "value: " - (cons "default" (mapcar #'symbol-name group))))) - (if (and arg (not (string= "default" arg))) - (concat arg " ") - ""))) - vals "")))))))) + (header-arg (or header-arg + (org-icompleting-read + "Header Arg: " + (mapcar + (lambda (header-spec) (symbol-name (car header-spec))) + headers)))) + (vals (cdr (assoc (intern header-arg) headers))) + (value (or value + (cond + ((eq vals :any) + (read-from-minibuffer "value: ")) + ((listp vals) + (mapconcat + (lambda (group) + (let ((arg (org-icompleting-read + "Value: " + (cons "default" + (mapcar #'symbol-name group))))) + (if (and arg (not (string= "default" arg))) + (concat arg " ") + ""))) + vals "")))))) + (save-excursion + (goto-char begin) + (goto-char (point-at-eol)) + (unless (= (char-before (point)) ?\ ) (insert " ")) + (insert ":" header-arg) (when value (insert " " value))))) ;; Add support for completing-read insertion of header arguments after ":" (defun org-babel-header-arg-expand () @@ -912,15 +985,15 @@ with a prefix argument then this is passed on to (org-edit-src-code) (funcall swap-windows))) +;;;###autoload (defmacro org-babel-do-in-edit-buffer (&rest body) "Evaluate BODY in edit buffer if there is a code block at point. Return t if a code block was found at point, nil otherwise." `(let ((org-src-window-setup 'switch-invisibly)) (when (and (org-babel-where-is-src-block-head) - (org-edit-src-code nil nil nil)) + (org-edit-src-code)) (unwind-protect (progn ,@body) - (if (org-bound-and-true-p org-edit-src-from-org-mode) - (org-edit-src-exit))) + (org-edit-src-exit)) t))) (def-edebug-spec org-babel-do-in-edit-buffer (body)) @@ -941,7 +1014,7 @@ evaluation mechanisms." (defvar org-bracket-link-regexp) (defun org-babel-active-location-p () - (memq (car (save-match-data (org-element-context))) + (memq (org-element-type (save-match-data (org-element-context))) '(babel-call inline-babel-call inline-src-block src-block))) ;;;###autoload @@ -995,7 +1068,8 @@ beg-body --------- point at the beginning of the body end-body --------- point at the end of the body" (declare (indent 1)) (let ((tempvar (make-symbol "file"))) - `(let* ((,tempvar ,file) + `(let* ((case-fold-search t) + (,tempvar ,file) (visited-p (or (null ,tempvar) (get-file-buffer (expand-file-name ,tempvar)))) (point (point)) to-be-removed) @@ -1034,7 +1108,8 @@ If FILE is nil evaluate BODY forms on source blocks in current buffer." (declare (indent 1)) (let ((tempvar (make-symbol "file"))) - `(let* ((,tempvar ,file) + `(let* ((case-fold-search t) + (,tempvar ,file) (visited-p (or (null ,tempvar) (get-file-buffer (expand-file-name ,tempvar)))) (point (point)) to-be-removed) @@ -1158,7 +1233,20 @@ the current subtree." (member (car arg) '(:results :exports))) (mapconcat #'identity (sort (funcall rm (split-string v)) #'string<) " ")) - (t v))))))) + (t v)))))) + ;; expanded body + (lang (nth 0 info)) + (params (nth 2 info)) + (body (if (org-babel-noweb-p params :eval) + (org-babel-expand-noweb-references info) (nth 1 info))) + (expand-cmd (intern (concat "org-babel-expand-body:" lang))) + (assignments-cmd (intern (concat "org-babel-variable-assignments:" + lang))) + (expanded + (if (fboundp expand-cmd) (funcall expand-cmd body params) + (org-babel-expand-body:generic + body params (and (fboundp assignments-cmd) + (funcall assignments-cmd params)))))) (let* ((it (format "%s-%s" (mapconcat #'identity @@ -1167,19 +1255,19 @@ the current subtree." (when normalized (format "%S" normalized)))) (nth 2 info))) ":") - (nth 1 info))) + expanded)) (hash (sha1 it))) (when (org-called-interactively-p 'interactive) (message hash)) hash)))) -(defun org-babel-current-result-hash () +(defun org-babel-current-result-hash (&optional info) "Return the current in-buffer hash." - (org-babel-where-is-src-block-result) + (org-babel-where-is-src-block-result nil info) (org-no-properties (match-string 5))) -(defun org-babel-set-current-result-hash (hash) +(defun org-babel-set-current-result-hash (hash info) "Set the current in-buffer hash to HASH." - (org-babel-where-is-src-block-result) + (org-babel-where-is-src-block-result nil info) (save-excursion (goto-char (match-beginning 5)) (mapc #'delete-overlay (overlays-at (point))) (forward-char org-babel-hash-show) @@ -1321,33 +1409,31 @@ specified in the properties of the current outline entry." (save-match-data (list ;; DEPRECATED header arguments specified as separate property at - ;; point of definition - (let (val sym) - (org-babel-parse-multiple-vars - (delq nil - (mapcar - (lambda (header-arg) - (and (setq val (org-entry-get (point) header-arg t)) - (cons (intern (concat ":" header-arg)) - (org-babel-read val)))) - (mapcar - #'symbol-name - (mapcar - #'car - (org-babel-combine-header-arg-lists - org-babel-common-header-args-w-values - (progn - (setq sym (intern (concat "org-babel-header-args:" lang))) - (and (boundp sym) (eval sym)))))))))) + ;; point of definition. + (org-babel-parse-multiple-vars + (delq nil + (mapcar + (lambda (header) + (let* ((arg (symbol-name (car header))) + (val (org-entry-get (point) arg t))) + (and val + (cons (intern (concat ":" arg)) + (org-babel-read val))))) + (org-babel-combine-header-arg-lists + org-babel-common-header-args-w-values + (let ((sym (intern (concat "org-babel-header-args:" lang)))) + (and (boundp sym) (symbol-value sym))))))) ;; header arguments specified with the header-args property at - ;; point of call + ;; point of call. (org-babel-parse-header-arguments (org-entry-get org-babel-current-src-block-location - "header-args" 'inherit)) - (when lang ;; language-specific header arguments at point of call - (org-babel-parse-header-arguments - (org-entry-get org-babel-current-src-block-location - (concat "header-args:" lang) 'inherit)))))) + "header-args" + 'inherit)) + (and lang ; language-specific header arguments at point of call + (org-babel-parse-header-arguments + (org-entry-get org-babel-current-src-block-location + (concat "header-args:" lang) + 'inherit)))))) (defvar org-src-preserve-indentation) ;; declare defcustom from org-src (defun org-babel-parse-src-block-match () @@ -1395,7 +1481,8 @@ specified in the properties of the current outline entry." (append (org-babel-params-from-properties lang) (list (org-babel-parse-header-arguments - (org-no-properties (or (match-string 4) ""))))))))) + (org-no-properties (or (match-string 4) "")))))) + nil))) (defun org-babel-balanced-split (string alts) "Split STRING on instances of ALTS. @@ -1512,7 +1599,7 @@ shown below. ;; row and column names (defun org-babel-del-hlines (table) "Remove all 'hlines from TABLE." - (remove 'hline table)) + (remq 'hline table)) (defun org-babel-get-colnames (table) "Return the column names of TABLE. @@ -1608,33 +1695,20 @@ to the table for reinsertion to org-mode." (defun org-babel-where-is-src-block-head () "Find where the current source block begins. -Return the point at the beginning of the current source -block. Specifically at the beginning of the #+BEGIN_SRC line. +Return the point at the beginning of the current source block. +Specifically at the beginning of the #+BEGIN_SRC line. Also set +match-data relatively to `org-babel-src-block-regexp', which see. If the point is not on a source block then return nil." - (let ((initial (point)) (case-fold-search t) top bottom) - (or - (save-excursion ;; on a source name line or a #+header line - (beginning-of-line 1) - (and (or (looking-at org-babel-src-name-regexp) - (looking-at org-babel-multi-line-header-regexp)) - (progn - (while (and (forward-line 1) - (or (looking-at org-babel-src-name-regexp) - (looking-at org-babel-multi-line-header-regexp)))) - (looking-at org-babel-src-block-regexp)) - (point))) - (save-excursion ;; on a #+begin_src line - (beginning-of-line 1) - (and (looking-at org-babel-src-block-regexp) - (point))) - (save-excursion ;; inside a src block - (and - (re-search-backward "^[ \t]*#\\+begin_src" nil t) (setq top (point)) - (re-search-forward "^[ \t]*#\\+end_src" nil t) (setq bottom (point)) - (< top initial) (< initial bottom) - (progn (goto-char top) (beginning-of-line 1) - (looking-at org-babel-src-block-regexp)) - (point-marker)))))) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'src-block) + (let ((end (org-element-property :end element))) + (org-with-wide-buffer + ;; Ensure point is not on a blank line after the block. + (beginning-of-line) + (skip-chars-forward " \r\t\n" end) + (when (< (point) end) + (prog1 (goto-char (org-element-property :post-affiliated element)) + (looking-at org-babel-src-block-regexp)))))))) ;;;###autoload (defun org-babel-goto-src-block-head () @@ -1682,23 +1756,22 @@ If the point is not on a source block then return nil." (defun org-babel-find-named-block (name) "Find a named source-code block. Return the location of the source block identified by source -NAME, or nil if no such block exists. Set match data according to -org-babel-named-src-block-regexp." +NAME, or nil if no such block exists. Set match data according +to `org-babel-named-src-block-regexp'." (save-excursion - (let ((case-fold-search t) - (regexp (org-babel-named-src-block-regexp-for-name name)) msg) - (goto-char (point-min)) - (when (or (re-search-forward regexp nil t) - (re-search-backward regexp nil t)) - (match-beginning 0))))) + (goto-char (point-min)) + (ignore-errors + (org-next-block 1 nil (org-babel-named-src-block-regexp-for-name name))))) (defun org-babel-src-block-names (&optional file) "Returns the names of source blocks in FILE or the current buffer." + (when file (find-file file)) (save-excursion - (when file (find-file file)) (goto-char (point-min)) - (let ((case-fold-search t) names) - (while (re-search-forward org-babel-src-name-w-name-regexp nil t) - (setq names (cons (match-string 3) names))) + (goto-char (point-min)) + (let ((re (org-babel-named-src-block-regexp-for-name)) + names) + (while (ignore-errors (org-next-block 1 nil re)) + (push (org-match-string-no-properties 9) names)) names))) ;;;###autoload @@ -1777,10 +1850,14 @@ split. When called from outside of a code block a new code block is created. In both cases if the region is demarcated and if the region is not active then the point is demarcated." (interactive "P") - (let ((info (org-babel-get-src-block-info 'light)) - (headers (progn (org-babel-where-is-src-block-head) - (match-string 4))) - (stars (concat (make-string (or (org-current-level) 1) ?*) " "))) + (let* ((info (org-babel-get-src-block-info 'light)) + (start (org-babel-where-is-src-block-head)) + (block (and start (match-string 0))) + (headers (and start (match-string 4))) + (stars (concat (make-string (or (org-current-level) 1) ?*) " ")) + (lower-case-p (and block + (let (case-fold-search) + (org-string-match-p "#\\+begin_src" block))))) (if info (mapc (lambda (place) @@ -1794,9 +1871,10 @@ region is not active then the point is demarcated." (delete-region (point-at-bol) (point-at-eol))) (insert (concat (if (looking-at "^") "" "\n") - indent "#+end_src\n" + indent (funcall (if lower-case-p 'downcase 'upcase) "#+end_src\n") (if arg stars indent) "\n" - indent "#+begin_src " lang + indent (funcall (if lower-case-p 'downcase 'upcase) "#+begin_src ") + lang (if (> (length headers) 1) (concat " " headers) headers) (if (looking-at "[\n\r]") @@ -1816,11 +1894,12 @@ region is not active then the point is demarcated." (if (org-region-active-p) (mark) (point)) (point)))) (insert (concat (if (looking-at "^") "" "\n") (if arg (concat stars "\n") "") - "#+begin_src " lang "\n" + (funcall (if lower-case-p 'downcase 'upcase) "#+begin_src ") + lang "\n" body (if (or (= (length body) 0) (string-match "[\r\n]$" body)) "" "\n") - "#+end_src\n")) + (funcall (if lower-case-p 'downcase 'upcase) "#+end_src\n"))) (goto-char start) (move-end-of-line 1))))) (defvar org-babel-lob-one-liner-regexp) @@ -1865,26 +1944,30 @@ following the source block." (progn (end-of-line 1) (if (eobp) (insert "\n") (forward-char 1)) (setq end (point)) - (or (and - (not name) - (progn ;; unnamed results line already exists - (catch 'non-comment - (while (re-search-forward "[^ \f\t\n\r\v]" nil t) - (beginning-of-line 1) - (cond - ((looking-at (concat org-babel-result-regexp "\n")) - (throw 'non-comment t)) - ((looking-at "^[ \t]*#") (end-of-line 1)) - (t (throw 'non-comment nil)))))) - (let ((this-hash (match-string 5))) - (prog1 (point) - ;; must remove and rebuild if hash!=old-hash - (if (and hash (not (string= hash this-hash))) - (prog1 nil - (forward-line 1) - (delete-region - end (org-babel-result-end))) - (setq end nil))))))))))) + (and + (not name) + (progn ;; unnamed results line already exists + (catch 'non-comment + (while (re-search-forward "[^ \f\t\n\r\v]" nil t) + (beginning-of-line 1) + (cond + ((looking-at (concat org-babel-result-regexp "\n")) + (throw 'non-comment t)) + ((and (looking-at "^[ \t]*#") + (not (looking-at + org-babel-lob-one-liner-regexp))) + (end-of-line 1)) + (t (throw 'non-comment nil)))))) + (let ((this-hash (match-string 5))) + (prog1 (point) + ;; must remove and rebuild if hash!=old-hash + (if (and hash (not (string= hash this-hash))) + (progn + (setq end (point-at-bol)) + (forward-line 1) + (delete-region end (org-babel-result-end)) + (setq beg end)) + (setq end nil)))))))))) (if (not (and insert end)) found (goto-char end) (unless beg @@ -1912,7 +1995,7 @@ following the source block." ((org-at-table-p) (org-babel-read-table)) ((org-at-item-p) (org-babel-read-list)) ((looking-at org-bracket-link-regexp) (org-babel-read-link)) - ((looking-at org-block-regexp) (org-babel-trim (match-string 4))) + ((looking-at org-block-regexp) (org-remove-indentation (match-string 4))) ((or (looking-at "^[ \t]*: ") (looking-at "^[ \t]*:$")) (setq result-string (org-babel-trim @@ -1969,23 +2052,29 @@ If the path of the link is a file path it is expanded using (funcall echo-res result)))) (defun org-babel-insert-result - (result &optional result-params info hash indent lang) + (result &optional result-params info hash indent lang) "Insert RESULT into the current buffer. -By default RESULT is inserted after the end of the -current source block. With optional argument RESULT-PARAMS -controls insertion of results in the org-mode file. -RESULT-PARAMS can take the following values: + +By default RESULT is inserted after the end of the current source +block. The RESULT of an inline source block usually will be +wrapped inside a `results' macro and placed on the same line as +the inline source block. The macro is stripped upon export. +Multiline and non-scalar RESULTS from inline source blocks are +not allowed. With optional argument RESULT-PARAMS controls +insertion of results in the Org mode file. RESULT-PARAMS can +take the following values: replace - (default option) insert results after the source block - replacing any previously inserted results + or inline source block replacing any previously + inserted results. silent -- no results are inserted into the Org-mode buffer but the results are echoed to the minibuffer and are ingested by Emacs (a potentially time consuming - process) + process). file ---- the results are interpreted as a file path, and are - inserted into the buffer using the Org-mode file syntax + inserted into the buffer using the Org-mode file syntax. list ---- the results are interpreted as an Org-mode list. @@ -1994,26 +2083,49 @@ raw ----- results are added directly to the Org-mode file. This formatted text. drawer -- results are added directly to the Org-mode file as with - \"raw\", but are wrapped in a RESULTS drawer, allowing - them to later be replaced or removed automatically. + \"raw\", but are wrapped in a RESULTS drawer or results + macro, allowing them to later be replaced or removed + automatically. + +org ----- results are added inside of a \"src_org{}\" or \"#+BEGIN_SRC + org\" block depending on whether the current source block is + inline or not. They are not comma-escaped when inserted, + but Org syntax here will be discarded when exporting the + file. + +html ---- results are added inside of a #+BEGIN_HTML block or + html export snippet depending on whether the current + source block is inline or not. This is a good option + if your code block will output html formatted text. + +latex --- results are added inside of a #+BEGIN_LATEX block or + latex export snippet depending on whether the current + source block is inline or not. This is a good option + if your code block will output latex formatted text. -org ----- results are added inside of a \"#+BEGIN_SRC org\" block. - They are not comma-escaped when inserted, but Org syntax - here will be discarded when exporting the file. +code ---- the results are extracted in the syntax of the source + code of the language being evaluated and are added + inside of a source block with the source-code language + set appropriately. Also, source block inlining is + preserved in this case. Note this relies on the + optional LANG argument. -html ---- results are added inside of a #+BEGIN_HTML block. This - is a good option if you code block will output html - formatted text. +list ---- the results are rendered as a list. This option not + allowed for inline src blocks. -latex --- results are added inside of a #+BEGIN_LATEX block. - This is a good option if you code block will output - latex formatted text. +table --- the results are rendered as a table. This option not + allowed for inline src blocks. + +INFO may provide the values of these header arguments (in the +`header-arguments-alist' see the docstring for +`org-babel-get-src-block-info'): + +:file --- the name of the file to which output should be written. + +:wrap --- the effect is similar to `latex' in RESULT-PARAMS but + using the argument supplied to specify the export block + or snippet type." -code ---- the results are extracted in the syntax of the source - code of the language being evaluated and are added - inside of a #+BEGIN_SRC block with the source-code - language set appropriately. Note this relies on the - optional LANG argument." (if (stringp result) (progn (setq result (org-no-properties result)) @@ -2033,15 +2145,23 @@ code ---- the results are extracted in the syntax of the source (when (or (org-babel-get-inline-src-block-matches) (org-babel-get-lob-one-liner-matches)) (goto-char (match-end 0)) - (insert (if (listp result) "\n" " ")) + (org-babel-remove-inline-result) + (insert " ") (point)))) - (existing-result (unless inlinep - (org-babel-where-is-src-block-result - t info hash indent))) + (existing-result + (unless inlinep + (org-babel-where-is-src-block-result t info hash indent))) + (bad-inline-p + (when inlinep + (or + (and (member "table" result-params) "`:results table'") + (and (listp result) "list result") + (and (org-string-match-p "\n." result) "multiline result") + (and (member "list" result-params) "`:results list'")))) (results-switches (cdr (assoc :results_switches (nth 2 info)))) - (visible-beg (copy-marker (point-min))) - (visible-end (copy-marker (point-max))) + (visible-beg (point-min-marker)) + (visible-end (point-max-marker)) ;; When results exist outside of the current visible ;; region of the buffer, be sure to widen buffer to ;; update them. @@ -2074,18 +2194,37 @@ code ---- the results are extracted in the syntax of the source ((member "prepend" result-params)))) ; already there (setq results-switches (if results-switches (concat " " results-switches) "")) - (let ((wrap (lambda (start finish &optional no-escape) - (goto-char end) (insert (concat finish "\n")) - (goto-char beg) (insert (concat start "\n")) + (let ((wrap (lambda (start finish &optional no-escape no-newlines + inline-start inline-finish) + (when inlinep + (setq start inline-start) + (setq finish inline-finish) + (setq no-newlines t)) + (goto-char end) + (insert (concat finish (unless no-newlines "\n"))) + (goto-char beg) + (insert (concat start (unless no-newlines "\n"))) (unless no-escape (org-escape-code-in-region (min (point) end) end)) - (goto-char end) (goto-char (point-at-eol)) + (goto-char end) + (unless no-newlines (goto-char (point-at-eol))) (setq end (point-marker)))) - (proper-list-p (lambda (it) (and (listp it) (null (cdr (last it))))))) + (tabulablep + (lambda (r) + ;; Non-nil when result R can be turned into + ;; a table. + (and (listp r) + (null (cdr (last r))) + (org-every + (lambda (e) (or (atom e) (null (cdr (last e))))) + result))))) ;; insert results based on type (cond - ;; do nothing for an empty result + ;; Do nothing for an empty result. ((null result)) + ;; Illegal inline result or params. + (bad-inline-p + (error "Inline error: %s cannot be used" bad-inline-p)) ;; insert a list if preferred ((member "list" result-params) (insert @@ -2097,51 +2236,78 @@ code ---- the results are extracted in the syntax of the source (if (listp result) result (split-string result "\n" t)))) '(:splicep nil :istart "- " :iend "\n"))) "\n")) - ;; assume the result is a table if it's not a string - ((funcall proper-list-p result) + ;; Try hard to print RESULT as a table. Give up if + ;; it contains an improper list. + ((funcall tabulablep result) (goto-char beg) (insert (concat (orgtbl-to-orgtbl (if (org-every - (lambda (el) (or (listp el) (eq el 'hline))) + (lambda (e) + (or (eq e 'hline) (listp e))) result) - result (list result)) - '(:fmt (lambda (cell) (format "%s" cell)))) "\n")) - (goto-char beg) (when (org-at-table-p) (org-table-align))) - ((and (listp result) (not (funcall proper-list-p result))) - (insert (format "%s\n" result))) + result + (list result)) + nil) + "\n")) + (goto-char beg) + (when (org-at-table-p) (org-table-align)) + (goto-char (org-table-end))) + ;; Print verbatim a list that cannot be turned into + ;; a table. + ((listp result) (insert (format "%s\n" result))) ((member "file" result-params) - (when inlinep (goto-char inlinep)) + (when inlinep + (goto-char inlinep) + (setq result (org-macro-escape-arguments result))) (insert result)) + ((and inlinep + (not (member "raw" result-params))) + (goto-char inlinep) + (insert (org-macro-escape-arguments + (org-babel-chomp result "\n")))) (t (goto-char beg) (insert result))) - (when (funcall proper-list-p result) (goto-char (org-table-end))) (setq end (point-marker)) ;; possibly wrap result (cond + (bad-inline-p) ; Do nothing. ((assoc :wrap (nth 2 info)) (let ((name (or (cdr (assoc :wrap (nth 2 info))) "RESULTS"))) (funcall wrap (concat "#+BEGIN_" name) - (concat "#+END_" (car (org-split-string name)))))) + (concat "#+END_" (car (org-split-string name))) + nil nil (concat "{{{results(@@" name ":") "@@)}}}"))) ((member "html" result-params) - (funcall wrap "#+BEGIN_HTML" "#+END_HTML")) + (funcall wrap "#+BEGIN_HTML" "#+END_HTML" nil nil + "{{{results(@@html:" "@@)}}}")) ((member "latex" result-params) - (funcall wrap "#+BEGIN_LaTeX" "#+END_LaTeX")) + (funcall wrap "#+BEGIN_LaTeX" "#+END_LaTeX" nil nil + "{{{results(@@latex:" "@@)}}}")) ((member "org" result-params) (goto-char beg) (if (org-at-table-p) (org-cycle)) - (funcall wrap "#+BEGIN_SRC org" "#+END_SRC")) + (funcall wrap "#+BEGIN_SRC org" "#+END_SRC" nil nil + "{{{results(src_org{" "})}}}")) ((member "code" result-params) - (funcall wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches) - "#+END_SRC")) + (let ((lang (or lang "none"))) + (funcall wrap (format "#+BEGIN_SRC %s%s" lang results-switches) + "#+END_SRC" nil nil + (format "{{{results(src_%s[%s]{" lang results-switches) + "})}}}"))) ((member "raw" result-params) (goto-char beg) (if (org-at-table-p) (org-cycle))) ((or (member "drawer" result-params) ;; Stay backward compatible with <7.9.2 (member "wrap" result-params)) (goto-char beg) (if (org-at-table-p) (org-cycle)) - (funcall wrap ":RESULTS:" ":END:" 'no-escape)) - ((and (not (funcall proper-list-p result)) + (funcall wrap ":RESULTS:" ":END:" 'no-escape nil + "{{{results(" ")}}}")) + ((and inlinep (member "file" result-params)) + (funcall wrap nil nil nil nil "{{{results(" ")}}}")) + ((and (not (funcall tabulablep result)) (not (member "file" result-params))) - (org-babel-examplize-region beg end results-switches) - (setq end (point))))) + (let ((org-babel-inline-result-wrap + ;; Hard code {{{results(...)}}} on top of customization. + (format "{{{results(%s)}}}" org-babel-inline-result-wrap))) + (org-babel-examplify-region beg end results-switches) + (setq end (point)))))) ;; possibly indent the results to match the #+results line (when (and (not inlinep) (numberp indent) indent (> indent 0) ;; in this case `table-align' does the work for us @@ -2157,15 +2323,44 @@ code ---- the results are extracted in the syntax of the source (set-marker visible-beg nil) (set-marker visible-end nil)))))) -(defun org-babel-remove-result (&optional info) +(defun org-babel-remove-result (&optional info keep-keyword) "Remove the result of the current source block." (interactive) - (let ((location (org-babel-where-is-src-block-result nil info)) start) + (let ((location (org-babel-where-is-src-block-result nil info))) (when location - (setq start (- location 1)) (save-excursion - (goto-char location) (forward-line 1) - (delete-region start (org-babel-result-end)))))) + (goto-char location) + (when (looking-at (concat org-babel-result-regexp ".*$")) + (delete-region + (if keep-keyword (1+ (match-end 0)) (1- (match-beginning 0))) + (progn (forward-line 1) (org-babel-result-end)))))))) + +(defun org-babel-remove-inline-result () + "Remove the result of the current inline-src-block or babel call. +The result must be wrapped in a `results' macro to be removed. +Leading whitespace is trimmed." + (interactive) + (let* ((el (org-element-context)) + (post-blank (org-element-property :post-blank el))) + (when (memq (org-element-type el) '(inline-src-block inline-babel-call)) + (org-with-wide-buffer + (goto-char (org-element-property :end el)) + (let ((el (org-element-context))) + (when (and (eq (org-element-type el) 'macro) + (string= (org-element-property :key el) "results")) + (delete-region ; And leading whitespace. + (- (org-element-property :begin el) post-blank) + (- (org-element-property :end el) + (org-element-property :post-blank el))))))))) + +(defun org-babel-remove-result-one-or-many (x) + "Remove the result of the current source block. +If called with a prefix argument, remove all result blocks +in the buffer." + (interactive "P") + (if x + (org-babel-map-src-blocks nil (org-babel-remove-result)) + (org-babel-remove-result))) (defun org-babel-result-end () "Return the point at the end of the current set of results." @@ -2203,18 +2398,27 @@ file's directory then expand relative links." result) (if description (concat "[" description "]") "")))) -(defvar org-babel-capitalize-examplize-region-markers nil +(defvar org-babel-capitalize-example-region-markers nil "Make true to capitalize begin/end example markers inserted by code blocks.") -(defun org-babel-examplize-region (beg end &optional results-switches) +(define-obsolete-function-alias + 'org-babel-examplize-region + 'org-babel-examplify-region "25.1") + +(defun org-babel-examplify-region (beg end &optional results-switches) "Comment out region using the inline '==' or ': ' org example quote." (interactive "*r") (let ((chars-between (lambda (b e) - (not (string-match "^[\\s]*$" (buffer-substring b e))))) - (maybe-cap (lambda (str) (if org-babel-capitalize-examplize-region-markers - (upcase str) str)))) - (if (or (funcall chars-between (save-excursion (goto-char beg) (point-at-bol)) beg) - (funcall chars-between end (save-excursion (goto-char end) (point-at-eol)))) + (not (string-match "^[\\s]*$" + (buffer-substring b e))))) + (maybe-cap (lambda (str) (if org-babel-capitalize-example-region-markers + (upcase str) str))) + (beg-bol (save-excursion (goto-char beg) (point-at-bol))) + (end-bol (save-excursion (goto-char end) (point-at-bol))) + (end-eol (save-excursion (goto-char end) (point-at-eol)))) + (if (and (not (= end end-bol)) + (or (funcall chars-between beg-bol beg) + (funcall chars-between end end-eol))) (save-excursion (goto-char beg) (insert (format org-babel-inline-result-wrap @@ -2242,7 +2446,8 @@ file's directory then expand relative links." (if (not (org-babel-where-is-src-block-head)) (error "Not in a source block") (save-match-data - (replace-match (concat (org-babel-trim new-body) "\n") nil t nil 5)) + (replace-match (concat (org-babel-trim (org-remove-indentation new-body)) + "\n") nil t nil 5)) (indent-rigidly (match-beginning 5) (match-end 5) 2))) (defun org-babel-merge-params (&rest plists) @@ -2331,6 +2536,16 @@ parameters when merging lists." (setq exports (funcall e-merge exports-exclusive-groups exports '("results")))) (setq params (cons pair (assq-delete-all (car pair) params))))) + (:file-ext + (when (cdr pair) + (setq results (funcall e-merge results-exclusive-groups + results '("file"))) + (unless (or (member "both" exports) + (member "none" exports) + (member "code" exports)) + (setq exports (funcall e-merge exports-exclusive-groups + exports '("results")))) + (setq params (cons pair (assq-delete-all (car pair) params))))) (:exports (setq exports (funcall e-merge exports-exclusive-groups exports (split-string (cdr pair))))) @@ -2523,7 +2738,8 @@ block but are passed literally to the \"example-block\"." (and expansion (mapconcat #'identity (nreverse (cdr expansion)) ""))) ;; Possibly raise an error if named block doesn't exist. - (if (member lang org-babel-noweb-error-langs) + (if (or org-babel-noweb-error-all-langs + (member lang org-babel-noweb-error-langs)) (error "%s" (concat (org-babel-noweb-wrap source-name) "could not be resolved (see " @@ -2533,60 +2749,106 @@ block but are passed literally to the \"example-block\"." (funcall nb-add (buffer-substring index (point-max)))) new-body)) +(defun org-babel--script-escape-inner (str) + (let (in-single in-double backslash out) + (mapc + (lambda (ch) + (setq + out + (if backslash + (progn + (setq backslash nil) + (cond + ((and in-single (eq ch ?')) + ;; Escaped single quote inside single quoted string: + ;; emit just a single quote, since we've changed the + ;; outer quotes to double. + (cons ch out)) + ((eq ch ?\") + ;; Escaped double quote + (if in-single + ;; This should be interpreted as backslash+quote, + ;; not an escape. Emit a three backslashes + ;; followed by a quote (because one layer of + ;; quoting will be stripped by `org-babel-read'). + (append (list ch ?\\ ?\\ ?\\) out) + ;; Otherwise we are in a double-quoted string. Emit + ;; a single escaped quote + (append (list ch ?\\) out))) + ((eq ch ?\\) + ;; Escaped backslash: emit a single escaped backslash + (append (list ?\\ ?\\) out)) + ;; Other: emit a quoted backslash followed by whatever + ;; the character was (because one layer of quoting will + ;; be stripped by `org-babel-read'). + (t (append (list ch ?\\ ?\\) out)))) + (case ch + (?\[ (if (or in-double in-single) + (cons ?\[ out) + (cons ?\( out))) + (?\] (if (or in-double in-single) + (cons ?\] out) + (cons ?\) out))) + (?\{ (if (or in-double in-single) + (cons ?\{ out) + (cons ?\( out))) + (?\} (if (or in-double in-single) + (cons ?\} out) + (cons ?\) out))) + (?, (if (or in-double in-single) + (cons ?, out) (cons ?\s out))) + (?\' (if in-double + (cons ?\' out) + (setq in-single (not in-single)) (cons ?\" out))) + (?\" (if in-single + (append (list ?\" ?\\) out) + (setq in-double (not in-double)) (cons ?\" out))) + (?\\ (unless (or in-single in-double) + (error "Can't handle backslash outside string in `org-babel-script-escape'")) + (setq backslash t) + out) + (t (cons ch out)))))) + (string-to-list str)) + (when (or in-single in-double) + (error "Unterminated string in `org-babel-script-escape'")) + (apply #'string (reverse out)))) + (defun org-babel-script-escape (str &optional force) "Safely convert tables into elisp lists." + (unless (stringp str) + (error "`org-babel-script-escape' expects a string")) (let ((escaped - (if (or force - (and (stringp str) - (> (length str) 2) - (or (and (string-equal "[" (substring str 0 1)) - (string-equal "]" (substring str -1))) - (and (string-equal "{" (substring str 0 1)) - (string-equal "}" (substring str -1))) - (and (string-equal "(" (substring str 0 1)) - (string-equal ")" (substring str -1)))))) - (org-babel-read - (concat - "'" - (let (in-single in-double out) - (mapc - (lambda (ch) - (setq - out - (case ch - (91 (if (or in-double in-single) ; [ - (cons 91 out) - (cons 40 out))) - (93 (if (or in-double in-single) ; ] - (cons 93 out) - (cons 41 out))) - (123 (if (or in-double in-single) ; { - (cons 123 out) - (cons 40 out))) - (125 (if (or in-double in-single) ; } - (cons 125 out) - (cons 41 out))) - (44 (if (or in-double in-single) ; , - (cons 44 out) (cons 32 out))) - (39 (if in-double ; ' - (cons 39 out) - (setq in-single (not in-single)) (cons 34 out))) - (34 (if in-single ; " - (append (list 34 32) out) - (setq in-double (not in-double)) (cons 34 out))) - (t (cons ch out))))) - (string-to-list str)) - (apply #'string (reverse out))))) - str))) + (cond + ((and (> (length str) 2) + (or (and (string-equal "[" (substring str 0 1)) + (string-equal "]" (substring str -1))) + (and (string-equal "{" (substring str 0 1)) + (string-equal "}" (substring str -1))) + (and (string-equal "(" (substring str 0 1)) + (string-equal ")" (substring str -1))))) + + (concat "'" (org-babel--script-escape-inner str))) + ((or force + (and (> (length str) 2) + (or (and (string-equal "'" (substring str 0 1)) + (string-equal "'" (substring str -1))) + ;; We need to pass double-quoted strings + ;; through the backslash-twiddling bits, even + ;; though we don't need to change their + ;; delimiters. + (and (string-equal "\"" (substring str 0 1)) + (string-equal "\"" (substring str -1)))))) + (org-babel--script-escape-inner str)) + (t str)))) (condition-case nil (org-babel-read escaped) (error escaped)))) (defun org-babel-read (cell &optional inhibit-lisp-eval) "Convert the string value of CELL to a number if appropriate. -Otherwise if cell looks like lisp (meaning it starts with a -\"(\", \"'\", \"`\" or a \"[\") then read it as lisp, -otherwise return it unmodified as a string. Optional argument -NO-LISP-EVAL inhibits lisp evaluation for situations in which is -it not appropriate." +Otherwise if CELL looks like lisp (meaning it starts with a +\"(\", \"'\", \"\\=`\" or a \"[\") then read and evaluate it as +lisp, otherwise return it unmodified as a string. Optional +argument INHIBIT-LISP-EVAL inhibits lisp evaluation for +situations in which is it not appropriate." (if (and (stringp cell) (not (equal cell ""))) (or (org-babel-number-p cell) (if (and (not inhibit-lisp-eval) @@ -2637,9 +2899,9 @@ If the table is trivial, then return it as a scalar." cell) t)) (defun org-babel-chomp (string &optional regexp) - "Strip trailing spaces and carriage returns from STRING. -Default regexp used is \"[ \f\t\n\r\v]\" but can be -overwritten by specifying a regexp as a second argument." + "Strip a trailing space or carriage return from STRING. +The default regexp used is \"[ \\f\\t\\n\\r\\v]\" but another one +can be specified as the REGEXP argument." (let ((regexp (or regexp "[ \f\t\n\r\v]"))) (while (and (> (length string) 0) (string-match regexp (substring string -1))) @@ -2647,12 +2909,12 @@ overwritten by specifying a regexp as a second argument." string)) (defun org-babel-trim (string &optional regexp) - "Strip leading and trailing spaces and carriage returns from STRING. -Like `org-babel-chomp' only it runs on both the front and back -of the string." - (org-babel-chomp (org-reverse-string - (org-babel-chomp (org-reverse-string string) regexp)) - regexp)) + "Strip a leading and trailing space or carriage return from STRING. +Like `org-babel-chomp', but run on both the first and last +character of the string." + (org-babel-chomp + (org-reverse-string + (org-babel-chomp (org-reverse-string string) regexp)) regexp)) (defun org-babel-tramp-handle-call-process-region (start end program &optional delete buffer display &rest args) @@ -2675,11 +2937,7 @@ Fixes a bug in `tramp-handle-call-process-region'." (defun org-babel-local-file-name (file) "Return the local name component of FILE." - (if (file-remote-p file) - (let (localname) - (with-parsed-tramp-file-name file nil - localname)) - file)) + (or (file-remote-p file 'localname) file)) (defun org-babel-process-file-name (name &optional no-quote-p) "Prepare NAME to be used in an external process. @@ -2688,7 +2946,7 @@ name is removed, since in that case the process will be executing remotely. The file name is then processed by `expand-file-name'. Unless second argument NO-QUOTE-P is non-nil, the file name is additionally processed by `shell-quote-argument'" - (let ((f (expand-file-name (org-babel-local-file-name name)))) + (let ((f (org-babel-local-file-name (expand-file-name name)))) (if no-quote-p f (shell-quote-argument f)))) (defvar org-babel-temporary-directory) @@ -2702,6 +2960,11 @@ additionally processed by `shell-quote-argument'" Used by `org-babel-temp-file'. This directory will be removed on Emacs shutdown.")) +(defcustom org-babel-remote-temporary-directory "/tmp/" + "Directory to hold temporary files on remote hosts." + :group 'org-babel + :type 'string) + (defmacro org-babel-result-cond (result-params scalar-form &rest table-forms) "Call the code to parse raw string results according to RESULT-PARAMS." (declare (indent 1) @@ -2714,6 +2977,7 @@ Emacs shutdown.")) (member "html" ,params) (member "code" ,params) (member "pp" ,params) + (member "file" ,params) (and (or (member "output" ,params) (member "raw" ,params) (member "org" ,params) @@ -2731,7 +2995,8 @@ of `org-babel-temporary-directory'." (if (file-remote-p default-directory) (let ((prefix (concat (file-remote-p default-directory) - (expand-file-name prefix temporary-file-directory)))) + (expand-file-name + prefix org-babel-remote-temporary-directory)))) (make-temp-file prefix nil suffix)) (let ((temporary-file-directory (or (and (boundp 'org-babel-temporary-directory) @@ -2766,6 +3031,69 @@ of `org-babel-temporary-directory'." (add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory) +(defun org-babel-one-header-arg-safe-p (pair safe-list) + "Determine if the PAIR is a safe babel header arg according to SAFE-LIST. + +For the format of SAFE-LIST, see `org-babel-safe-header-args'." + (and (consp pair) + (keywordp (car pair)) + (stringp (cdr pair)) + (or + (memq (car pair) safe-list) + (let ((entry (assq (car pair) safe-list))) + (and entry + (consp entry) + (cond ((functionp (cdr entry)) + (funcall (cdr entry) (cdr pair))) + ((listp (cdr entry)) + (member (cdr pair) (cdr entry))) + (t nil))))))) + +(defun org-babel-generate-file-param (src-name params) + "Calculate the filename for source block results. + +The directory is calculated from the :output-dir property of the +source block; if not specified, use the current directory. + +If the source block has a #+NAME and the :file parameter does not +contain any period characters, then the :file parameter is +treated as an extension, and the output file name is the +concatenation of the directory (as calculated above), the block +name, a period, and the parameter value as a file extension. +Otherwise, the :file parameter is treated as a full file name, +and the output file name is the directory (as calculated above) +plus the parameter value." + (let* ((file-cons (assq :file params)) + (file-ext-cons (assq :file-ext params)) + (file-ext (cdr-safe file-ext-cons)) + (dir (cdr-safe (assq :output-dir params))) + fname) + ;; create the output-dir if it does not exist + (when dir + (make-directory dir t)) + (if file-cons + ;; :file given; add :output-dir if given + (when dir + (setcdr file-cons (concat (file-name-as-directory dir) (cdr file-cons)))) + ;; :file not given; compute from name and :file-ext if possible + (when (and src-name file-ext) + (if dir + (setq fname (concat (file-name-as-directory (or dir "")) + src-name "." file-ext)) + (setq fname (concat src-name "." file-ext))) + (setq params (cons (cons :file fname) params)))) + params)) + +;;; Used by backends: R, Maxima, Octave. +(defun org-babel-graphical-output-file (params) + "File where a babel block should send graphical output, per PARAMS." + (unless (assq :file params) + (if (assq :file-ext params) + (user-error ":file-ext given but no :file generated; did you forget to give a block a #+NAME?") + (user-error "No :file header argument given; cannot create graphical result."))) + (and (member "graphics" (cdr (assq :result-params params))) + (cdr (assq :file params)))) + (provide 'ob-core) ;; Local variables: |