diff options
Diffstat (limited to 'lisp/org/ob-core.el')
| -rw-r--r-- | lisp/org/ob-core.el | 435 |
1 files changed, 218 insertions, 217 deletions
diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index 9e78876787a..f877ff51bfd 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -35,6 +35,7 @@ (defvar org-babel-library-of-babel) (defvar org-edit-src-content-indentation) +(defvar org-link-file-path-type) (defvar org-src-lang-modes) (defvar org-src-preserve-indentation) @@ -47,10 +48,8 @@ (declare-function org-babel-ref-resolve "ob-ref" (ref)) (declare-function org-babel-ref-split-args "ob-ref" (arg-string)) (declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info)) -(declare-function org-completing-read "org" (&rest args)) (declare-function org-current-level "org" ()) (declare-function org-cycle "org" (&optional arg)) -(declare-function org-do-remove-indentation "org" (&optional n)) (declare-function org-edit-src-code "org-src" (&optional code edit-buffer-name)) (declare-function org-edit-src-exit "org-src" ()) (declare-function org-element-at-point "org-element" ()) @@ -60,9 +59,7 @@ (declare-function org-element-type "org-element" (element)) (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) (declare-function org-escape-code-in-region "org-src" (beg end)) -(declare-function org-get-indentation "org" (&optional line)) -(declare-function org-get-indentation "org" (&optional line)) -(declare-function org-in-regexp "org" (regexp &optional nlines visually)) +(declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) (declare-function org-indent-line "org" ()) (declare-function org-list-get-list-end "org-list" (item struct prevs)) (declare-function org-list-prevs-alist "org-list" (struct)) @@ -75,24 +72,18 @@ (declare-function org-narrow-to-subtree "org" ()) (declare-function org-next-block "org" (arg &optional backward block-regexp)) (declare-function org-open-at-point "org" (&optional in-emacs reference-buffer)) -(declare-function org-outline-overlay-data "org" (&optional use-markers)) (declare-function org-previous-block "org" (arg &optional block-regexp)) -(declare-function org-remove-indentation "org" (code &optional n)) -(declare-function org-reverse-string "org" (string)) -(declare-function org-set-outline-overlay-data "org" (data)) (declare-function org-show-context "org" (&optional key)) (declare-function org-src-coderef-format "org-src" (&optional element)) (declare-function org-src-coderef-regexp "org-src" (fmt &optional label)) +(declare-function org-src-get-lang-mode "org-src" (lang)) (declare-function org-table-align "org-table" ()) (declare-function org-table-end "org-table" (&optional table-type)) (declare-function org-table-import "org-table" (file arg)) (declare-function org-table-to-lisp "org-table" (&optional txt)) -(declare-function org-trim "org" (s &optional keep-lead)) (declare-function org-unescape-code-in-string "org-src" (s)) -(declare-function org-uniquify "org" (list)) (declare-function orgtbl-to-generic "org-table" (table params)) (declare-function orgtbl-to-orgtbl "org-table" (table params)) -(declare-function outline-show-all "outline" ()) (declare-function tramp-compat-make-temp-file "tramp-compat" (filename &optional dir-flag)) (defgroup org-babel nil @@ -186,9 +177,14 @@ This string must include a \"%s\" which will be replaced by the results." :safe #'booleanp) (defun org-babel-noweb-wrap (&optional regexp) - (concat org-babel-noweb-wrap-start - (or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)") - org-babel-noweb-wrap-end)) + "Return regexp matching a Noweb reference. + +Match any reference, or only those matching REGEXP, if non-nil. + +When matching, reference is stored in match group 1." + (concat (regexp-quote org-babel-noweb-wrap-start) + (or regexp "\\([^ \t\n]\\(?:.*?[^ \t\n]\\)?\\)") + (regexp-quote org-babel-noweb-wrap-end))) (defvar org-babel-src-name-regexp "^[ \t]*#\\+name:[ \t]*" @@ -416,7 +412,7 @@ then run `org-babel-switch-to-session'." (post . :any) (prologue . :any) (results . ((file list vector table scalar verbatim) - (raw html latex org code pp drawer) + (raw html latex org code pp drawer link graphics) (replace silent none append prepend) (output value))) (rownames . ((no yes))) @@ -532,7 +528,7 @@ to raise errors for all languages.") "Hook for functions to be called after `org-babel-execute-src-block'") (defun org-babel-named-src-block-regexp-for-name (&optional name) - "Generate a regexp used to match a src block named NAME. + "Generate a regexp used to match a source 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'." @@ -566,7 +562,7 @@ Remove final newline character and spurious indentation." ;;; functions (defvar org-babel-current-src-block-location nil - "Marker pointing to the src block currently being executed. + "Marker pointing to the source block currently being executed. This may also point to a call line or an inline code block. If multiple blocks are being executed (e.g., in chained execution through use of the :var header argument) this marker points to @@ -577,9 +573,10 @@ the outer-most code block.") (defun org-babel-get-src-block-info (&optional light datum) "Extract information from a source block or inline source block. -Optional argument LIGHT does not resolve remote variable -references; a process which could likely result in the execution -of other code blocks. +When optional argument LIGHT is non-nil, Babel does not resolve +remote variable references; a process which could likely result +in the execution of other code blocks, and do not evaluate Lisp +values in parameters. By default, consider the block at point. However, when optional argument DATUM is provided, extract information from that parsed @@ -610,8 +607,9 @@ a list with the following pattern: ;; properties applicable to its location within ;; the document. (org-with-point-at (org-element-property :begin datum) - (org-babel-params-from-properties lang)) - (mapcar #'org-babel-parse-header-arguments + (org-babel-params-from-properties lang light)) + (mapcar (lambda (h) + (org-babel-parse-header-arguments h light)) (cons (org-element-property :parameters datum) (org-element-property :header datum))))) (or (org-element-property :switches datum) "") @@ -654,7 +652,7 @@ block." (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))) + (new-hash (and cache (org-babel-sha1-hash info :eval))) (old-hash (and cache (org-babel-current-result-hash))) (current-cache (and new-hash (equal new-hash old-hash)))) (cond @@ -681,9 +679,16 @@ block." (replace-regexp-in-string (org-src-coderef-regexp coderef) "" expand nil nil 1)))) (dir (cdr (assq :dir params))) + (mkdirp (cdr (assq :mkdirp params))) (default-directory - (or (and dir (file-name-as-directory (expand-file-name dir))) - default-directory)) + (cond + ((not dir) default-directory) + ((member mkdirp '("no" "nil" nil)) + (file-name-as-directory (expand-file-name dir))) + (t + (let ((d (file-name-as-directory (expand-file-name dir)))) + (make-directory d 'parents) + d)))) (cmd (intern (concat "org-babel-execute:" lang))) result) (unless (fboundp cmd) @@ -703,13 +708,20 @@ block." (not (listp r))) (list (list r)) r))) - (let ((file (cdr (assq :file params)))) + (let ((file (and (member "file" result-params) + (cdr (assq :file params))))) ;; If non-empty result and :file then write to :file. (when file - (when result + ;; If `:results' are special types like `link' or + ;; `graphics', don't write result to `:file'. Only + ;; insert a link to `:file'. + (when (and result + (not (or (member "link" result-params) + (member "graphics" result-params)))) (with-temp-file file (insert (org-babel-format-result - result (cdr (assq :sep params)))))) + result + (cdr (assq :sep params)))))) (setq result file)) ;; Possibly perform post process provided its ;; appropriate. Dynamically bind "*this*" to the @@ -1013,7 +1025,7 @@ evaluation mechanisms." (call-interactively (key-binding (or key (read-key-sequence nil)))))) -(defvar org-bracket-link-regexp) +(defvar org-link-bracket-re) (defun org-babel-active-location-p () (memq (org-element-type (save-match-data (org-element-context))) @@ -1021,30 +1033,32 @@ evaluation mechanisms." ;;;###autoload (defun org-babel-open-src-block-result (&optional re-run) - "If `point' is on a src block then open the results of the -source code block, otherwise return nil. With optional prefix -argument RE-RUN the source-code block is evaluated even if -results already exist." + "Open results of source block at point. + +If `point' is on a source block then open the results of the source +code block, otherwise return nil. With optional prefix argument +RE-RUN the source-code block is evaluated even if results already +exist." (interactive "P") - (let ((info (org-babel-get-src-block-info 'light))) - (when info - (save-excursion - ;; go to the results, if there aren't any then run the block - (goto-char (or (and (not re-run) (org-babel-where-is-src-block-result)) - (progn (org-babel-execute-src-block) - (org-babel-where-is-src-block-result)))) - (end-of-line 1) - (while (looking-at "[\n\r\t\f ]") (forward-char 1)) - ;; open the results - (if (looking-at org-bracket-link-regexp) - ;; file results - (org-open-at-point) - (let ((r (org-babel-format-result - (org-babel-read-result) (cdr (assq :sep (nth 2 info)))))) - (pop-to-buffer (get-buffer-create "*Org-Babel Results*")) - (delete-region (point-min) (point-max)) - (insert r))) - t)))) + (pcase (org-babel-get-src-block-info 'light) + (`(,_ ,_ ,arguments ,_ ,_ ,start ,_) + (save-excursion + ;; Go to the results, if there aren't any then run the block. + (goto-char start) + (goto-char (or (and (not re-run) (org-babel-where-is-src-block-result)) + (progn (org-babel-execute-src-block) + (org-babel-where-is-src-block-result)))) + (end-of-line) + (skip-chars-forward " \r\t\n") + ;; Open the results. + (if (looking-at org-link-bracket-re) (org-open-at-point) + (let ((r (org-babel-format-result (org-babel-read-result) + (cdr (assq :sep arguments))))) + (pop-to-buffer (get-buffer-create "*Org Babel Results*")) + (erase-buffer) + (insert r))) + t)) + (_ nil))) ;;;###autoload (defmacro org-babel-map-src-blocks (file &rest body) @@ -1224,11 +1238,14 @@ the current subtree." (widen)))) ;;;###autoload -(defun org-babel-sha1-hash (&optional info) - "Generate an sha1 hash based on the value of info." +(defun org-babel-sha1-hash (&optional info context) + "Generate a sha1 hash based on the value of INFO. +CONTEXT specifies the context of evaluation. It can be `:eval', +`:export', `:tangle'. A nil value means `:eval'." (interactive) (let ((print-level nil) - (info (or info (org-babel-get-src-block-info)))) + (info (or info (org-babel-get-src-block-info))) + (context (or context :eval))) (setf (nth 2 info) (sort (copy-sequence (nth 2 info)) (lambda (a b) (string< (car a) (car b))))) @@ -1256,8 +1273,9 @@ the current subtree." ;; 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))) + (body (if (org-babel-noweb-p params context) + (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))) @@ -1288,19 +1306,6 @@ the current subtree." (looking-at org-babel-result-regexp) (match-string-no-properties 1))))) -(defun org-babel-set-current-result-hash (hash info) - "Set the current in-buffer hash to HASH." - (org-with-wide-buffer - (goto-char (org-babel-where-is-src-block-result nil info)) - (looking-at org-babel-result-regexp) - (goto-char (match-beginning 1)) - (mapc #'delete-overlay (overlays-at (point))) - (forward-char org-babel-hash-show) - (mapc #'delete-overlay (overlays-at (point))) - (replace-match hash nil nil nil 1) - (beginning-of-line) - (org-babel-hide-hash))) - (defun org-babel-hide-hash () "Hide the hash in the current results line. Only the initial `org-babel-hash-show' characters of the hash @@ -1426,24 +1431,27 @@ portions of results lines." (lambda () (add-hook 'change-major-mode-hook 'org-babel-show-result-all 'append 'local))) -(defvar org-file-properties) -(defun org-babel-params-from-properties (&optional lang) - "Retrieve parameters specified as properties. -Return a list of association lists of source block params +(defun org-babel-params-from-properties (&optional lang no-eval) + "Retrieve source block parameters specified as properties. + +LANG is the language of the source block, as a string. When +optional argument NO-EVAL is non-nil, do not evaluate Lisp values +in parameters. + +Return a list of association lists of source block parameters specified in the properties of the current outline entry." (save-match-data (list - ;; header arguments specified with the header-args property at + ;; Header arguments specified with the header-args property at ;; point of call. (org-babel-parse-header-arguments - (org-entry-get org-babel-current-src-block-location - "header-args" - 'inherit)) - (and lang ; language-specific header arguments at point of call + (org-entry-get (point) "header-args" 'inherit) + no-eval) + ;; Language-specific header arguments at point of call. + (and lang (org-babel-parse-header-arguments - (org-entry-get org-babel-current-src-block-location - (concat "header-args:" lang) - 'inherit)))))) + (org-entry-get (point) (concat "header-args:" lang) 'inherit) + no-eval))))) (defun org-babel-balanced-split (string alts) "Split STRING on instances of ALTS. @@ -1531,9 +1539,11 @@ balanced instances of \"[ \t]:\", set ALTS to ((32 9) . 58)." (cons el acc)))) list :initial-value nil)))) -(defun org-babel-parse-header-arguments (arg-string) - "Parse a string of header arguments returning an alist." - (when (> (length arg-string) 0) +(defun org-babel-parse-header-arguments (string &optional no-eval) + "Parse header arguments in STRING. +When optional argument NO-EVAL is non-nil, do not evaluate Lisp +in parameters. Return an alist." + (when (org-string-nw-p string) (org-babel-parse-multiple-vars (delq nil (mapcar @@ -1542,10 +1552,12 @@ balanced instances of \"[ \t]:\", set ALTS to ((32 9) . 58)." "\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)" arg) (cons (intern (match-string 1 arg)) - (org-babel-read (org-babel-chomp (match-string 2 arg)))) + (org-babel-read (org-babel-chomp (match-string 2 arg)) + no-eval)) (cons (intern (org-babel-chomp arg)) nil))) - (let ((raw (org-babel-balanced-split arg-string '((32 9) . 58)))) - (cons (car raw) (mapcar (lambda (r) (concat ":" r)) (cdr raw))))))))) + (let ((raw (org-babel-balanced-split string '((32 9) . 58)))) + (cons (car raw) + (mapcar (lambda (r) (concat ":" r)) (cdr raw))))))))) (defun org-babel-parse-multiple-vars (header-arguments) "Expand multiple variable assignments behind a single :var keyword. @@ -1845,7 +1857,7 @@ With optional prefix argument ARG, jump backward ARG many source blocks." ;;;###autoload (defun org-babel-mark-block () - "Mark current src block." + "Mark current source block." (interactive) (let ((head (org-babel-where-is-src-block-head))) (when head @@ -1876,7 +1888,7 @@ region is not active then the point is demarcated." (save-excursion (goto-char place) (let ((lang (nth 0 info)) - (indent (make-string (org-get-indentation) ?\s))) + (indent (make-string (current-indentation) ?\s))) (when (string-match "^[[:space:]]*$" (buffer-substring (point-at-bol) (point-at-eol))) @@ -2083,7 +2095,7 @@ Return nil if ELEMENT cannot be read." (`paragraph ;; Treat paragraphs containing a single link specially. (skip-chars-forward " \t") - (if (and (looking-at org-bracket-link-regexp) + (if (and (looking-at org-link-bracket-re) (save-excursion (goto-char (match-end 0)) (skip-chars-forward " \r\t\n") @@ -2125,7 +2137,7 @@ Return nil if ELEMENT cannot be read." If the path of the link is a file path it is expanded using `expand-file-name'." (let* ((case-fold-search t) - (raw (and (looking-at org-bracket-link-regexp) + (raw (and (looking-at org-link-bracket-re) (org-no-properties (match-string 1)))) (type (and (string-match org-link-types-re raw) (match-string 1 raw)))) @@ -2206,10 +2218,10 @@ code ---- the results are extracted in the syntax of the source optional LANG argument. list ---- the results are rendered as a list. This option not - allowed for inline src blocks. + allowed for inline source blocks. table --- the results are rendered as a table. This option not - allowed for inline src blocks. + allowed for inline source blocks. INFO may provide the values of these header arguments (in the `header-arguments-alist' see the docstring for @@ -2273,7 +2285,7 @@ INFO may provide the values of these header arguments (in the (goto-char (org-element-property :end inline)) (skip-chars-backward " \t")) (unless inline - (setq indent (org-get-indentation)) + (setq indent (current-indentation)) (forward-line 1)) (setq beg (point)) (cond @@ -2297,7 +2309,7 @@ INFO may provide the values of these header arguments (in the (setq start inline-start) (setq finish inline-finish) (setq no-newlines t)) - (let ((before-finish (marker-position end))) + (let ((before-finish (copy-marker end))) (goto-char end) (insert (concat finish (unless no-newlines "\n"))) (goto-char beg) @@ -2362,24 +2374,24 @@ INFO may provide the values of these header arguments (in the ;; possibly wrap result (cond ((assq :wrap (nth 2 info)) - (let ((name (or (cdr (assq :wrap (nth 2 info))) "RESULTS"))) - (funcall wrap (concat "#+BEGIN_" name) - (concat "#+END_" (car (split-string name))) + (let ((name (or (cdr (assq :wrap (nth 2 info))) "results"))) + (funcall wrap (concat "#+begin_" name) + (concat "#+end_" (car (split-string name))) nil nil (concat "{{{results(@@" name ":") "@@)}}}"))) ((member "html" result-params) - (funcall wrap "#+BEGIN_EXPORT html" "#+END_EXPORT" nil nil + (funcall wrap "#+begin_export html" "#+end_export" nil nil "{{{results(@@html:" "@@)}}}")) ((member "latex" result-params) - (funcall wrap "#+BEGIN_EXPORT latex" "#+END_EXPORT" nil nil + (funcall wrap "#+begin_export latex" "#+end_export" nil nil "{{{results(@@latex:" "@@)}}}")) ((member "org" result-params) (goto-char beg) (when (org-at-table-p) (org-cycle)) - (funcall wrap "#+BEGIN_SRC org" "#+END_SRC" nil nil + (funcall wrap "#+begin_src org" "#+end_src" nil nil "{{{results(src_org{" "})}}}")) ((member "code" result-params) (let ((lang (or lang "none"))) - (funcall wrap (format "#+BEGIN_SRC %s%s" lang results-switches) - "#+END_SRC" nil nil + (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) @@ -2388,7 +2400,7 @@ INFO may provide the values of these header arguments (in the ;; Stay backward compatible with <7.9.2 (member "wrap" result-params)) (goto-char beg) (when (org-at-table-p) (org-cycle)) - (funcall wrap ":RESULTS:" ":END:" 'no-escape nil + (funcall wrap ":results:" ":end:" 'no-escape nil "{{{results(" ")}}}")) ((and inline (member "file" result-params)) (funcall wrap nil nil nil nil "{{{results(" ")}}}")) @@ -2469,7 +2481,7 @@ in the buffer." (defun org-babel-result-end () "Return the point at the end of the current set of results." (cond ((looking-at-p "^[ \t]*$") (point)) ;no result - ((looking-at-p (format "^[ \t]*%s[ \t]*$" org-bracket-link-regexp)) + ((looking-at-p (format "^[ \t]*%s[ \t]*$" org-link-bracket-re)) (line-beginning-position 2)) (t (let ((element (org-element-at-point))) @@ -2489,15 +2501,20 @@ in the buffer." If the `default-directory' is different from the containing file's directory then expand relative links." (when (stringp result) - (format "[[file:%s]%s]" - (if (and default-directory - buffer-file-name - (not (string= (expand-file-name default-directory) - (expand-file-name - (file-name-directory buffer-file-name))))) - (expand-file-name result default-directory) - result) - (if description (concat "[" description "]") "")))) + (let ((same-directory? + (and buffer-file-name + (not (string= (expand-file-name default-directory) + (expand-file-name + (file-name-directory buffer-file-name))))))) + (format "[[file:%s]%s]" + (if (and default-directory buffer-file-name same-directory?) + (if (eq org-link-file-path-type 'adaptive) + (file-relative-name + (expand-file-name result default-directory) + (file-name-directory (buffer-file-name))) + (expand-file-name result default-directory)) + result) + (if description (concat "[" description "]") ""))))) (defun org-babel-examplify-region (beg end &optional results-switches inline) "Comment out region using the inline `==' or `: ' org example quote." @@ -2535,7 +2552,7 @@ file's directory then expand relative links." (unless (eq (org-element-type element) 'src-block) (error "Not in a source block")) (goto-char (org-babel-where-is-src-block-head element)) - (let* ((ind (org-get-indentation)) + (let* ((ind (current-indentation)) (body-start (line-beginning-position 2)) (body (org-element-normalize-string (if (or org-src-preserve-indentation @@ -2621,19 +2638,6 @@ parameters when merging lists." results (split-string (if (stringp value) value (eval value t)))))) - (`(,(or :file :file-ext) . ,value) - ;; `:file' and `:file-ext' are regular keywords but they - ;; imply a "file" `:results' and a "results" `:exports'. - (when value - (setq results - (funcall merge results-exclusive-groups results '("file"))) - (unless (or (member "both" exports) - (member "none" exports) - (member "code" exports)) - (setq exports - (funcall merge - exports-exclusive-groups exports '("results")))) - (push pair params))) (`(:exports . ,value) (setq exports (funcall merge exports-exclusive-groups @@ -2662,12 +2666,6 @@ parameters when merging lists." ;; Return merged params. params)) -(defvar org-babel-use-quick-and-dirty-noweb-expansion nil - "Set to true to use regular expressions to expand noweb references. -This results in much faster noweb reference expansion but does -not properly allow code blocks to inherit the \":noweb-ref\" -header argument from buffer or subtree wide properties.") - (defun org-babel-noweb-p (params context) "Check if PARAMS require expansion in CONTEXT. CONTEXT may be one of :tangle, :export or :eval." @@ -2714,16 +2712,8 @@ block but are passed literally to the \"example-block\"." (body (nth 1 info)) (ob-nww-start org-babel-noweb-wrap-start) (ob-nww-end org-babel-noweb-wrap-end) - (comment (string= "noweb" (cdr (assq :comments (nth 2 info))))) - (rx-prefix (concat "\\(" org-babel-src-name-regexp "\\|" - ":noweb-ref[ \t]+" "\\)")) (new-body "") (nb-add (lambda (text) (setq new-body (concat new-body text)))) - (c-wrap (lambda (text) - (with-temp-buffer - (funcall (intern (concat lang "-mode"))) - (comment-region (point) (progn (insert text) (point))) - (org-trim (buffer-string))))) index source-name evaluate prefix) (with-temp-buffer (setq-local org-babel-noweb-wrap-start ob-nww-start) @@ -2755,63 +2745,77 @@ block but are passed literally to the \"example-block\"." (let ((raw (org-babel-ref-resolve source-name))) (if (stringp raw) raw (format "%S" raw))) (or - ;; Retrieve from the library of babel. - (nth 2 (assoc (intern source-name) - org-babel-library-of-babel)) + ;; Retrieve from the Library of Babel. + (nth 2 (assoc-string source-name org-babel-library-of-babel)) ;; Return the contents of headlines literally. (save-excursion (when (org-babel-ref-goto-headline-id source-name) - (org-babel-ref-headline-body))) + (org-babel-ref-headline-body))) ;; Find the expansion of reference in this buffer. - (let ((rx (concat rx-prefix source-name "[ \t\n]")) - expansion) - (save-excursion - (goto-char (point-min)) - (if org-babel-use-quick-and-dirty-noweb-expansion - (while (re-search-forward rx nil t) - (let* ((i (org-babel-get-src-block-info 'light)) - (body (if (org-babel-noweb-p (nth 2 i) :eval) - (org-babel-expand-noweb-references i) - (nth 1 i))) - (sep (or (cdr (assq :noweb-sep (nth 2 i))) - "\n")) - (full (if comment - (let ((cs (org-babel-tangle-comment-links i))) - (concat (funcall c-wrap (car cs)) "\n" - body "\n" - (funcall c-wrap (cadr cs)))) - body))) - (setq expansion (cons sep (cons full expansion))))) - (org-babel-map-src-blocks nil - (let ((i (let ((org-babel-current-src-block-location (point))) - (org-babel-get-src-block-info 'light)))) - (when (equal (or (cdr (assq :noweb-ref (nth 2 i))) - (nth 4 i)) - source-name) - (let* ((body (if (org-babel-noweb-p (nth 2 i) :eval) - (org-babel-expand-noweb-references i) - (nth 1 i))) - (sep (or (cdr (assq :noweb-sep (nth 2 i))) - "\n")) - (full (if comment - (let ((cs (org-babel-tangle-comment-links i))) - (concat (funcall c-wrap (car cs)) "\n" - body "\n" - (funcall c-wrap (cadr cs)))) - body))) - (setq expansion - (cons sep (cons full expansion))))))))) - (and expansion - (mapconcat #'identity (nreverse (cdr expansion)) ""))) + (save-excursion + (goto-char (point-min)) + (let* ((name-regexp + (org-babel-named-src-block-regexp-for-name + source-name)) + (comment + (string= "noweb" + (cdr (assq :comments (nth 2 info))))) + (c-wrap + (lambda (s) + ;; Comment, according to LANG mode, + ;; string S. Return new string. + (with-temp-buffer + (funcall (org-src-get-lang-mode lang)) + (comment-region (point) + (progn (insert s) (point))) + (org-trim (buffer-string))))) + (expand-body + (lambda (i) + ;; Expand body of code blocked + ;; represented by block info I. + (let ((b (if (org-babel-noweb-p (nth 2 i) :eval) + (org-babel-expand-noweb-references i) + (nth 1 i)))) + (if (not comment) b + (let ((cs (org-babel-tangle-comment-links i))) + (concat (funcall c-wrap (car cs)) "\n" + b "\n" + (funcall c-wrap (cadr cs))))))))) + (if (and (re-search-forward name-regexp nil t) + (not (org-in-commented-heading-p))) + ;; Found a source block named SOURCE-NAME. + ;; Assume it is unique; do not look after + ;; `:noweb-ref' header argument. + (funcall expand-body + (org-babel-get-src-block-info 'light)) + ;; Though luck. We go into the long process + ;; of checking each source block and expand + ;; those with a matching Noweb reference. + (let ((expansion nil)) + (org-babel-map-src-blocks nil + (unless (org-in-commented-heading-p) + (let* ((info + (org-babel-get-src-block-info 'light)) + (parameters (nth 2 info))) + (when (equal source-name + (cdr (assq :noweb-ref parameters))) + (push (funcall expand-body info) expansion) + (push (or (cdr (assq :noweb-sep parameters)) + "\n") + expansion))))) + (when expansion + (mapconcat #'identity + (nreverse (cdr expansion)) + "")))))) ;; Possibly raise an error if named block doesn't exist. (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 " - "`org-babel-noweb-error-langs')")) + (error "%s could not be resolved (see \ +`org-babel-noweb-error-langs')" + (org-babel-noweb-wrap source-name)) ""))) - "[\n\r]") (concat "\n" prefix)))))) + "[\n\r]") + (concat "\n" prefix)))))) (funcall nb-add (buffer-substring index (point-max)))) new-body)) @@ -2927,30 +2931,30 @@ situations in which is it not appropriate." (defun org-babel--string-to-number (string) "If STRING represents a number return its value. Otherwise return nil." - (and (string-match-p "\\`-?[0-9]*\\.?[0-9]*\\'" string) + (and (string-match-p "\\`-?\\([0-9]\\|\\([1-9]\\|[0-9]*\\.\\)[0-9]*\\)\\'" string) (string-to-number string))) (defun org-babel-import-elisp-from-file (file-name &optional separator) "Read the results located at FILE-NAME into an elisp table. If the table is trivial, then return it as a scalar." - (let (result) - (save-window-excursion - (with-temp-buffer - (condition-case err - (progn - (org-table-import file-name separator) - (delete-file file-name) - (setq result (mapcar (lambda (row) - (mapcar #'org-babel-string-read row)) - (org-table-to-lisp)))) - (error (message "Error reading results: %s" err) nil))) - (if (null (cdr result)) ;; if result is trivial vector, then scalarize it - (if (consp (car result)) - (if (null (cdr (car result))) - (caar result) - result) - (car result)) - result)))) + (save-window-excursion + (let ((result + (with-temp-buffer + (condition-case err + (progn + (org-table-import file-name separator) + (delete-file file-name) + (delq nil + (mapcar (lambda (row) + (and (not (eq row 'hline)) + (mapcar #'org-babel-string-read row))) + (org-table-to-lisp)))) + (error (message "Error reading results: %s" err) nil))))) + (pcase result + (`((,scalar)) scalar) + (`((,_ ,_ . ,_)) result) + (`(,scalar) scalar) + (_ result))))) (defun org-babel-string-read (cell) "Strip nested \"s from around strings." @@ -3136,7 +3140,8 @@ after the babel API for OLD-type source blocks is fully defined. Callers of this function will probably want to add an entry to `org-src-lang-modes' as well." (dolist (fn '("execute" "expand-body" "prep-session" - "variable-assignments" "load-session")) + "variable-assignments" "load-session" + "edit-prep")) (let ((sym (intern-soft (concat "org-babel-" fn ":" old)))) (when (and sym (fboundp sym)) (defalias (intern (concat "org-babel-" fn ":" new)) sym)))) @@ -3147,10 +3152,6 @@ Callers of this function will probably want to add an entry to (when (and sym (boundp sym)) (defvaralias (intern (concat "org-babel-" var ":" new)) sym))))) -(defun org-babel-strip-quotes (string) - "Strip \\\"s from around a string, if applicable." - (org-unbracket-string "\"" "\"" string)) - (provide 'ob-core) ;; Local variables: |