dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

ob-core.el (136438B)


      1 ;;; ob-core.el --- Working with Code Blocks          -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2009-2023 Free Software Foundation, Inc.
      4 
      5 ;; Authors: Eric Schulte
      6 ;;	Dan Davison
      7 ;; Keywords: literate programming, reproducible research
      8 ;; URL: https://orgmode.org
      9 
     10 ;; This file is part of GNU Emacs.
     11 
     12 ;; GNU Emacs is free software: you can redistribute it and/or modify
     13 ;; it under the terms of the GNU General Public License as published by
     14 ;; the Free Software Foundation, either version 3 of the License, or
     15 ;; (at your option) any later version.
     16 
     17 ;; GNU Emacs is distributed in the hope that it will be useful,
     18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     20 ;; GNU General Public License for more details.
     21 
     22 ;; You should have received a copy of the GNU General Public License
     23 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
     24 
     25 ;;; Code:
     26 
     27 (require 'org-macs)
     28 (org-assert-version)
     29 
     30 (require 'cl-lib)
     31 (require 'ob-eval)
     32 (require 'org-macs)
     33 (require 'org-fold)
     34 (require 'org-compat)
     35 (require 'org-cycle)
     36 
     37 (defconst org-babel-exeext
     38   (if (memq system-type '(windows-nt cygwin))
     39       ".exe"
     40     nil))
     41 
     42 (defvar org-babel-library-of-babel)
     43 (defvar org-edit-src-content-indentation)
     44 (defvar org-link-file-path-type)
     45 (defvar org-src-lang-modes)
     46 (defvar org-src-preserve-indentation)
     47 (defvar org-babel-tangle-uncomment-comments)
     48 
     49 (declare-function org-attach-dir "org-attach" (&optional create-if-not-exists-p no-fs-check))
     50 (declare-function org-at-item-p "org-list" ())
     51 (declare-function org-at-table-p "org" (&optional table-type))
     52 (declare-function org-babel-lob-execute-maybe "ob-lob" ())
     53 (declare-function org-babel-ref-goto-headline-id "ob-ref" (id))
     54 (declare-function org-babel-ref-headline-body "ob-ref" ())
     55 (declare-function org-babel-ref-parse "ob-ref" (assignment))
     56 (declare-function org-babel-ref-resolve "ob-ref" (ref))
     57 (declare-function org-babel-ref-split-args "ob-ref" (arg-string))
     58 (declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info))
     59 (declare-function org-current-level "org" ())
     60 (declare-function org-cycle "org-cycle" (&optional arg))
     61 (declare-function org-edit-src-code "org-src" (&optional code edit-buffer-name))
     62 (declare-function org-edit-src-exit "org-src"  ())
     63 (declare-function org-element-at-point "org-element" (&optional pom cached-only))
     64 (declare-function org-element-at-point-no-context "org-element" (&optional pom))
     65 (declare-function org-element-context "org-element" (&optional element))
     66 (declare-function org-element-normalize-string "org-element" (s))
     67 (declare-function org-element-property "org-element" (property element))
     68 (declare-function org-element-type "org-element" (element))
     69 (declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
     70 (declare-function org-escape-code-in-region "org-src" (beg end))
     71 (declare-function org-forward-heading-same-level "org" (arg &optional invisible-ok))
     72 (declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
     73 (declare-function org-indent-line "org" ())
     74 (declare-function org-list-get-list-end "org-list" (item struct prevs))
     75 (declare-function org-list-prevs-alist "org-list" (struct))
     76 (declare-function org-list-struct "org-list" ())
     77 (declare-function org-list-to-generic "org-list" (LIST PARAMS))
     78 (declare-function org-list-to-lisp "org-list" (&optional delete))
     79 (declare-function org-list-to-org "org-list" (list &optional params))
     80 (declare-function org-macro-escape-arguments "org-macro" (&rest args))
     81 (declare-function org-mark-ring-push "org" (&optional pos buffer))
     82 (declare-function org-narrow-to-subtree "org" (&optional element))
     83 (declare-function org-next-block "org" (arg &optional backward block-regexp))
     84 (declare-function org-open-at-point "org" (&optional in-emacs reference-buffer))
     85 (declare-function org-previous-block "org" (arg &optional block-regexp))
     86 (declare-function org-fold-show-context "org-fold" (&optional key))
     87 (declare-function org-src-coderef-format "org-src" (&optional element))
     88 (declare-function org-src-coderef-regexp "org-src" (fmt &optional label))
     89 (declare-function org-src-get-lang-mode "org-src" (lang))
     90 (declare-function org-table-align "org-table" ())
     91 (declare-function org-table-convert-region "org-table" (beg0 end0 &optional separator))
     92 (declare-function org-table-end "org-table" (&optional table-type))
     93 (declare-function org-table-import "org-table" (file arg))
     94 (declare-function org-table-to-lisp "org-table" (&optional txt))
     95 (declare-function org-unescape-code-in-string "org-src" (s))
     96 (declare-function orgtbl-to-generic "org-table" (table params))
     97 (declare-function orgtbl-to-orgtbl "org-table" (table params))
     98 (declare-function tramp-compat-make-temp-file "tramp-compat" (filename &optional dir-flag))
     99 
    100 (defgroup org-babel nil
    101   "Code block evaluation and management in `org-mode' documents."
    102   :tag "Babel"
    103   :group 'org)
    104 
    105 (defcustom org-confirm-babel-evaluate t
    106   "Confirm before evaluation.
    107 \\<org-mode-map>\
    108 Require confirmation before interactively evaluating code
    109 blocks in Org buffers.  The default value of this variable is t,
    110 meaning confirmation is required for any code block evaluation.
    111 This variable can be set to nil to inhibit any future
    112 confirmation requests.  This variable can also be set to a
    113 function which takes two arguments the language of the code block
    114 and the body of the code block.  Such a function should then
    115 return a non-nil value if the user should be prompted for
    116 execution or nil if no prompt is required.
    117 
    118 Warning: Disabling confirmation may result in accidental
    119 evaluation of potentially harmful code.  It may be advisable
    120 remove code block execution from `\\[org-ctrl-c-ctrl-c]' \
    121 as further protection
    122 against accidental code block evaluation.  The
    123 `org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be used to
    124 remove code block execution from the `\\[org-ctrl-c-ctrl-c]' keybinding."
    125   :group 'org-babel
    126   :version "24.1"
    127   :type '(choice boolean function))
    128 ;; don't allow this variable to be changed through file settings
    129 (put 'org-confirm-babel-evaluate 'safe-local-variable (lambda (x) (eq x t)))
    130 
    131 (defcustom org-babel-no-eval-on-ctrl-c-ctrl-c nil
    132   "\\<org-mode-map>\
    133 Remove code block evaluation from the `\\[org-ctrl-c-ctrl-c]' key binding."
    134   :group 'org-babel
    135   :version "24.1"
    136   :type 'boolean)
    137 
    138 (defcustom org-babel-results-keyword "RESULTS"
    139   "Keyword used to name results generated by code blocks.
    140 It should be \"RESULTS\".  However any capitalization may be
    141 used."
    142   :group 'org-babel
    143   :version "24.4"
    144   :package-version '(Org . "8.0")
    145   :type 'string
    146   :safe (lambda (v)
    147 	  (and (stringp v)
    148 	       (org-string-equal-ignore-case "RESULTS" v))))
    149 
    150 (defcustom org-babel-noweb-wrap-start "<<"
    151   "String used to begin a noweb reference in a code block.
    152 See also `org-babel-noweb-wrap-end'."
    153   :group 'org-babel
    154   :type 'string)
    155 
    156 (defcustom org-babel-noweb-wrap-end ">>"
    157   "String used to end a noweb reference in a code block.
    158 See also `org-babel-noweb-wrap-start'."
    159   :group 'org-babel
    160   :type 'string)
    161 
    162 (defcustom org-babel-inline-result-wrap "=%s="
    163   "Format string used to wrap inline results.
    164 This string must include a \"%s\" which will be replaced by the results."
    165   :group 'org-babel
    166   :type 'string)
    167 (put 'org-babel-inline-result-wrap
    168      'safe-local-variable
    169      (lambda (value)
    170        (and (stringp value)
    171 	    (string-match-p "%s" value))))
    172 
    173 (defcustom org-babel-hash-show-time nil
    174   "Non-nil means show the time the code block was evaluated in the result hash."
    175   :group 'org-babel
    176   :type 'boolean
    177   :package-version '(Org . "9.0")
    178   :safe #'booleanp)
    179 
    180 (defcustom org-babel-uppercase-example-markers nil
    181   "When non-nil, begin/end example markers will be inserted in upper case."
    182   :group 'org-babel
    183   :type 'boolean
    184   :version "26.1"
    185   :package-version '(Org . "9.1")
    186   :safe #'booleanp)
    187 
    188 (defun org-babel-noweb-wrap (&optional regexp)
    189   "Return regexp matching a Noweb reference.
    190 
    191 Match any reference, or only those matching REGEXP, if non-nil.
    192 
    193 When matching, reference is stored in match group 1."
    194   (concat (regexp-quote org-babel-noweb-wrap-start)
    195 	  (or regexp "\\([^ \t\n]\\(?:.*?[^ \t\n]\\)?\\)")
    196 	  (regexp-quote org-babel-noweb-wrap-end)))
    197 
    198 (defvar org-babel-src-name-regexp
    199   "^[ \t]*#\\+name:[ \t]*"
    200   "Regular expression used to match a source name line.")
    201 
    202 (defvar org-babel-multi-line-header-regexp
    203   "^[ \t]*#\\+headers?:[ \t]*\\([^\n]*\\)$"
    204   "Regular expression used to match multi-line header arguments.")
    205 
    206 (defvar org-babel-src-block-regexp
    207   (concat
    208    ;; (1) indentation                 (2) lang
    209    "^\\([ \t]*\\)#\\+begin_src[ \t]+\\([^ \f\t\n\r\v]+\\)[ \t]*"
    210    ;; (3) switches
    211    "\\([^\":\n]*\"[^\"\n*]*\"[^\":\n]*\\|[^\":\n]*\\)"
    212    ;; (4) header arguments
    213    "\\([^\n]*\\)\n"
    214    ;; (5) body
    215    "\\([^\000]*?\n\\)??[ \t]*#\\+end_src")
    216   "Regexp used to identify code blocks.")
    217 
    218 (defun org-babel--get-vars (params)
    219   "Return the babel variable assignments in PARAMS.
    220 
    221 PARAMS is a quasi-alist of header args, which may contain
    222 multiple entries for the key `:var'.  This function returns a
    223 list of the cdr of all the `:var' entries."
    224   (mapcar #'cdr
    225 	  (cl-remove-if-not (lambda (x) (eq (car x) :var)) params)))
    226 
    227 (defvar org-babel-exp-reference-buffer nil
    228   "Buffer containing original contents of the exported buffer.
    229 This is used by Babel to resolve references in source blocks.
    230 Its value is dynamically bound during export.")
    231 
    232 (defun org-babel-check-confirm-evaluate (info)
    233   "Check whether INFO allows code block evaluation.
    234 
    235 Returns nil if evaluation is disallowed, t if it is
    236 unconditionally allowed, and the symbol `query' if the user
    237 should be asked whether to allow evaluation."
    238   (let* ((headers (nth 2 info))
    239 	 (eval (or (cdr  (assq :eval headers))
    240 		   (when (assq :noeval headers) "no")))
    241 	 (eval-no (member eval '("no" "never")))
    242 	 (export org-babel-exp-reference-buffer)
    243 	 (eval-no-export (and export (member eval '("no-export" "never-export"))))
    244 	 (noeval (or eval-no eval-no-export))
    245 	 (query (or (equal eval "query")
    246 		    (and export (equal eval "query-export"))
    247 		    (if (functionp org-confirm-babel-evaluate)
    248 			(funcall org-confirm-babel-evaluate
    249 				 ;; Language, code block body.
    250 				 (nth 0 info)
    251 				 (org-babel--expand-body info))
    252 		      org-confirm-babel-evaluate))))
    253     (cond
    254      (noeval nil)
    255      (query 'query)
    256      (t t))))
    257 
    258 (defun org-babel-check-evaluate (info)
    259   "Check if code block INFO should be evaluated.
    260 Do not query the user, but do display an informative message if
    261 evaluation is blocked.  Returns non-nil if evaluation is not blocked."
    262   (let ((confirmed (org-babel-check-confirm-evaluate info)))
    263     (unless confirmed
    264       (message "Evaluation of this %s code block%sis disabled."
    265 	       (nth 0 info)
    266 	       (let ((name (nth 4 info)))
    267 		 (if name (format " (%s) " name) " "))))
    268     confirmed))
    269 
    270 ;; Dynamically scoped for asynchronous export.
    271 (defvar org-babel-confirm-evaluate-answer-no)
    272 
    273 (defun org-babel-confirm-evaluate (info)
    274   "Confirm evaluation of the code block INFO.
    275 
    276 This query can also be suppressed by setting the value of
    277 `org-confirm-babel-evaluate' to nil, in which case all future
    278 interactive code block evaluations will proceed without any
    279 confirmation from the user.
    280 
    281 Note disabling confirmation may result in accidental evaluation
    282 of potentially harmful code.
    283 
    284 The variable `org-babel-confirm-evaluate-answer-no' is used by
    285 the async export process, which requires a non-interactive
    286 environment, to override this check."
    287   (let* ((evalp (org-babel-check-confirm-evaluate info))
    288 	 (lang (nth 0 info))
    289 	 (name (nth 4 info))
    290 	 (name-string (if name (format " (%s) " name) " ")))
    291     (pcase evalp
    292       (`nil nil)
    293       (`t t)
    294       (`query (or
    295 	       (and (not (bound-and-true-p
    296 			  org-babel-confirm-evaluate-answer-no))
    297 		    (yes-or-no-p
    298 		     (format "Evaluate this %s code block%son your system? "
    299 			     lang name-string)))
    300 	       (progn
    301 		 (message "Evaluation of this %s code block%sis aborted."
    302 			  lang name-string)
    303 		 nil)))
    304       (x (error "Unexpected value `%s' from `org-babel-check-confirm-evaluate'" x)))))
    305 
    306 ;;;###autoload
    307 (defun org-babel-execute-safely-maybe ()
    308   (unless org-babel-no-eval-on-ctrl-c-ctrl-c
    309     (org-babel-execute-maybe)))
    310 
    311 ;;;###autoload
    312 (defun org-babel-execute-maybe ()
    313   (interactive)
    314   (or (org-babel-execute-src-block-maybe)
    315       (org-babel-lob-execute-maybe)))
    316 
    317 (defmacro org-babel-when-in-src-block (&rest body)
    318   "Execute BODY if point is in a source block and return t.
    319 
    320 Otherwise do nothing and return nil."
    321   `(if (memq (org-element-type (org-element-context))
    322 	     '(inline-src-block src-block))
    323        (progn
    324 	 ,@body
    325 	 t)
    326      nil))
    327 
    328 (defun org-babel-execute-src-block-maybe ()
    329   "Conditionally execute a source block.
    330 Detect if this is context for a Babel src-block and if so
    331 then run `org-babel-execute-src-block'."
    332   (interactive)
    333   (org-babel-when-in-src-block
    334    (org-babel-eval-wipe-error-buffer)
    335    (org-babel-execute-src-block current-prefix-arg)))
    336 
    337 ;;;###autoload
    338 (defun org-babel-view-src-block-info ()
    339   "Display information on the current source block.
    340 This includes header arguments, language and name, and is largely
    341 a window into the `org-babel-get-src-block-info' function."
    342   (interactive)
    343   (let ((info (org-babel-get-src-block-info 'no-eval))
    344 	(full (lambda (it) (> (length it) 0)))
    345 	(printf (lambda (fmt &rest args) (princ (apply #'format fmt args)))))
    346     (when info
    347       (with-help-window (help-buffer)
    348 	(let ((name        (nth 4 info))
    349 	      (lang        (nth 0 info))
    350 	      (switches    (nth 3 info))
    351 	      (header-args (nth 2 info)))
    352 	  (when name            (funcall printf "Name: %s\n"     name))
    353 	  (when lang            (funcall printf "Lang: %s\n"     lang))
    354 	  (funcall printf "Properties:\n")
    355 	  (funcall printf "\t:header-args \t%s\n" (org-entry-get (point) "header-args" t))
    356 	  (funcall printf "\t:header-args:%s \t%s\n" lang (org-entry-get (point) (concat "header-args:" lang) t))
    357 
    358 	  (when (funcall full switches) (funcall printf "Switches: %s\n" switches))
    359 	  (funcall printf "Header Arguments:\n")
    360 	  (dolist (pair (sort header-args
    361 			      (lambda (a b) (string< (symbol-name (car a))
    362 						     (symbol-name (car b))))))
    363 	    (when (funcall full (format "%s" (cdr pair)))
    364 	      (funcall printf "\t%S%s\t%s\n"
    365 		       (car pair)
    366 		       (if (> (length (format "%S" (car pair))) 7) "" "\t")
    367 		       (cdr pair)))))))))
    368 
    369 ;;;###autoload
    370 (defun org-babel-expand-src-block-maybe ()
    371   "Conditionally expand a source block.
    372 Detect if this is context for an org-babel src-block and if so
    373 then run `org-babel-expand-src-block'."
    374   (interactive)
    375   (org-babel-when-in-src-block
    376    (org-babel-expand-src-block current-prefix-arg)))
    377 
    378 ;;;###autoload
    379 (defun org-babel-load-in-session-maybe ()
    380   "Conditionally load a source block in a session.
    381 Detect if this is context for an org-babel src-block and if so
    382 then run `org-babel-load-in-session'."
    383   (interactive)
    384   (org-babel-when-in-src-block
    385    (org-babel-load-in-session current-prefix-arg)))
    386 
    387 (add-hook 'org-metaup-hook 'org-babel-load-in-session-maybe)
    388 
    389 ;;;###autoload
    390 (defun org-babel-pop-to-session-maybe ()
    391   "Conditionally pop to a session.
    392 Detect if this is context for an org-babel src-block and if so
    393 then run `org-babel-switch-to-session'."
    394   (interactive)
    395   (org-babel-when-in-src-block
    396    (org-babel-switch-to-session current-prefix-arg)))
    397 
    398 (add-hook 'org-metadown-hook 'org-babel-pop-to-session-maybe)
    399 
    400 (defconst org-babel-common-header-args-w-values
    401   '((cache	. ((no yes)))
    402     (cmdline	. :any)
    403     (colnames	. ((nil no yes)))
    404     (comments	. ((no link yes org both noweb)))
    405     (dir	. :any)
    406     (eval	. ((yes no no-export strip-export never-export eval never
    407 			query)))
    408     (exports	. ((code results both none)))
    409     (epilogue   . :any)
    410     (file	. :any)
    411     (file-desc  . :any)
    412     (file-ext   . :any)
    413     (file-mode  . ((#o755 #o555 #o444 :any)))
    414     (hlines	. ((no yes)))
    415     (mkdirp	. ((yes no)))
    416     (no-expand)
    417     (noeval)
    418     (noweb	. ((yes no tangle strip-tangle no-export strip-export)))
    419     (noweb-ref	. :any)
    420     (noweb-sep  . :any)
    421     (noweb-prefix . ((no yes)))
    422     (output-dir . :any)
    423     (padline	. ((yes no)))
    424     (post       . :any)
    425     (prologue   . :any)
    426     (results	. ((file list vector table scalar verbatim)
    427 		   (raw html latex org code pp drawer link graphics)
    428 		   (replace silent none discard append prepend)
    429 		   (output value)))
    430     (rownames	. ((no yes)))
    431     (sep	. :any)
    432     (session	. :any)
    433     (shebang	. :any)
    434     (tangle	. ((tangle yes no :any)))
    435     (tangle-mode . ((#o755 #o555 #o444 :any)))
    436     (var	. :any)
    437     (wrap       . :any)))
    438 
    439 (defconst org-babel-header-arg-names
    440   (mapcar #'car org-babel-common-header-args-w-values)
    441   "Common header arguments used by org-babel.
    442 Note that individual languages may define their own language
    443 specific header arguments as well.")
    444 
    445 (defconst org-babel-safe-header-args
    446   '(:cache :colnames :comments :exports :epilogue :hlines :noeval
    447 	   :noweb :noweb-ref :noweb-sep :noweb-prefix :padline
    448            :prologue :rownames :sep :session :tangle :wrap
    449 	   (:eval . ("never" "query"))
    450 	   (:results . (lambda (str) (not (string-match "file" str)))))
    451   "A list of safe header arguments for babel source blocks.
    452 
    453 The list can have entries of the following forms:
    454 - :ARG                     -> :ARG is always a safe header arg
    455 - (:ARG . (VAL1 VAL2 ...)) -> :ARG is safe as a header arg if it is
    456                               `equal' to one of the VALs.
    457 - (:ARG . FN)              -> :ARG is safe as a header arg if the function FN
    458                               returns non-nil.  FN is passed one
    459                               argument, the value of the header arg
    460                               (as a string).")
    461 
    462 (defmacro org-babel-header-args-safe-fn (safe-list)
    463   "Return a function that determines whether a list of header args are safe.
    464 
    465 Intended usage is:
    466 \(put \\='org-babel-default-header-args \\='safe-local-variable
    467  (org-babel-header-args-safe-p org-babel-safe-header-args)
    468 
    469 This allows org-babel languages to extend the list of safe values for
    470 their `org-babel-default-header-args:foo' variable.
    471 
    472 For the format of SAFE-LIST, see `org-babel-safe-header-args'."
    473   `(lambda (value)
    474      (and (listp value)
    475 	  (cl-every
    476 	   (lambda (pair)
    477 	     (and (consp pair)
    478 		  (org-babel-one-header-arg-safe-p pair ,safe-list)))
    479 	   value))))
    480 
    481 (defvar org-babel-default-header-args
    482   '((:session . "none") (:results . "replace") (:exports . "code")
    483     (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no"))
    484   "Default arguments to use when evaluating a source block.
    485 
    486 This is a list in which each element is an alist.  Each key
    487 corresponds to a header argument, and each value to that header's
    488 value.  The value can either be a string or a closure that
    489 evaluates to a string.
    490 
    491 A closure is evaluated when the source block is being
    492 evaluated (e.g. during execution or export), with point at the
    493 source block.  It is not possible to use an arbitrary function
    494 symbol (e.g. `some-func'), since org uses lexical binding.  To
    495 achieve the same functionality, call the function within a
    496 closure (e.g. (lambda () (some-func))).
    497 
    498 To understand how closures can be used as default header
    499 arguments, imagine you'd like to set the file name output of a
    500 latex source block to a sha1 of its contents.  We could achieve
    501 this with:
    502 
    503   (defun org-src-sha ()
    504     (let ((elem (org-element-at-point)))
    505       (concat (sha1 (org-element-property :value elem)) \".svg\")))
    506 
    507   (setq org-babel-default-header-args:latex
    508         `((:results . \"file link replace\")
    509           (:file . (lambda () (org-src-sha)))))
    510 
    511 Because the closure is evaluated with point at the source block,
    512 the call to `org-element-at-point' above will always retrieve
    513 information about the current source block.
    514 
    515 Some header arguments can be provided multiple times for a source
    516 block.  An example of such a header argument is :var.  This
    517 functionality is also supported for default header arguments by
    518 providing the header argument multiple times in the alist.  For
    519 example:
    520 
    521  ((:var . \"foo=\\\"bar\\\"\")
    522   (:var . \"bar=\\\"foo\\\"\"))")
    523 
    524 (put 'org-babel-default-header-args 'safe-local-variable
    525      (org-babel-header-args-safe-fn org-babel-safe-header-args))
    526 
    527 (defvar org-babel-default-inline-header-args
    528   '((:session . "none") (:results . "replace")
    529     (:exports . "results") (:hlines . "yes"))
    530   "Default arguments to use when evaluating an inline source block.")
    531 (put 'org-babel-default-inline-header-args 'safe-local-variable
    532      (org-babel-header-args-safe-fn org-babel-safe-header-args))
    533 
    534 (defconst org-babel-name-regexp
    535   (format "^[ \t]*#\\+%s:[ \t]*"
    536 	  ;; FIXME: TBLNAME is for backward compatibility.
    537 	  (regexp-opt '("NAME" "TBLNAME")))
    538   "Regexp matching a NAME keyword.")
    539 
    540 (defconst org-babel-result-regexp
    541   (rx (seq bol
    542            (zero-or-more (any "\t "))
    543            "#+results"
    544            (opt "["
    545 		;; Time stamp part.
    546 		(opt "("
    547                      (= 4 digit) (= 2 "-" (= 2 digit))
    548                      " "
    549                      (= 2 digit) (= 2 ":" (= 2 digit))
    550                      ") ")
    551 		;; SHA1 hash.
    552 		(group (one-or-more hex-digit))
    553 		"]")
    554            ":"
    555            (zero-or-more (any "\t "))))
    556   "Regular expression used to match result lines.
    557 If the results are associated with a hash key then the hash will
    558 be saved in match group 1.")
    559 
    560 (defconst org-babel-result-w-name-regexp
    561   (concat org-babel-result-regexp "\\(?9:[^ \t\n\r\v\f]+\\)")
    562   "Regexp matching a RESULTS keyword with a name.
    563 Name is saved in match group 9.")
    564 
    565 (defvar org-babel-min-lines-for-block-output 10
    566   "The minimum number of lines for block output.
    567 If number of lines of output is equal to or exceeds this
    568 value, the output is placed in a #+begin_example...#+end_example
    569 block.  Otherwise the output is marked as literal by inserting
    570 colons at the starts of the lines.  This variable only takes
    571 effect if the :results output option is in effect.")
    572 
    573 (defvar org-babel-noweb-error-all-langs nil
    574   "Raise errors when noweb references don't resolve.
    575 Also see `org-babel-noweb-error-langs' to control noweb errors on
    576 a language by language bases.")
    577 
    578 (defvar org-babel-noweb-error-langs nil
    579   "Languages for which Babel will raise literate programming errors.
    580 List of languages for which errors should be raised when the
    581 source code block satisfying a noweb reference in this language
    582 can not be resolved.  Also see `org-babel-noweb-error-all-langs'
    583 to raise errors for all languages.")
    584 
    585 (defvar org-babel-hash-show 4
    586   "Number of initial characters to show of a hidden results hash.")
    587 
    588 (defvar org-babel-after-execute-hook nil
    589   "Hook for functions to be called after `org-babel-execute-src-block'.")
    590 
    591 (defun org-babel-named-src-block-regexp-for-name (&optional name)
    592   "Generate a regexp used to match a source block named NAME.
    593 If NAME is nil, match any name.  Matched name is then put in
    594 match group 9.  Other match groups are defined in
    595 `org-babel-src-block-regexp'."
    596   (concat org-babel-src-name-regexp
    597 	  (concat (if name (regexp-quote name) "\\(?9:.*?\\)") "[ \t]*" )
    598 	  "\\(?:\n[ \t]*#\\+\\S-+:.*\\)*?"
    599 	  "\n"
    600 	  (substring org-babel-src-block-regexp 1)))
    601 
    602 (defun org-babel-named-data-regexp-for-name (name)
    603   "Generate a regexp used to match data named NAME."
    604   (concat org-babel-name-regexp (regexp-quote name) "[ \t]*$"))
    605 
    606 (defun org-babel--normalize-body (datum)
    607   "Normalize body for element or object DATUM.
    608 DATUM is a source block element or an inline source block object.
    609 Remove final newline character and spurious indentation."
    610   (let* ((value (org-element-property :value datum))
    611 	 (body (if (string-suffix-p "\n" value)
    612 		   (substring value 0 -1)
    613 		 value)))
    614     (cond ((eq (org-element-type datum) 'inline-src-block)
    615 	   ;; Newline characters and indentation in an inline
    616 	   ;; src-block are not meaningful, since they could come from
    617 	   ;; some paragraph filling.  Treat them as a white space.
    618 	   (replace-regexp-in-string "\n[ \t]*" " " body))
    619 	  ((or org-src-preserve-indentation
    620 	       (org-element-property :preserve-indent datum))
    621 	   body)
    622 	  (t (org-remove-indentation body)))))
    623 
    624 ;;; functions
    625 (defvar org-babel-current-src-block-location nil
    626   "Marker pointing to the source block currently being executed.
    627 This may also point to a call line or an inline code block.  If
    628 multiple blocks are being executed (e.g., in chained execution
    629 through use of the :var header argument) this marker points to
    630 the outer-most code block.")
    631 
    632 (defun org-babel-eval-headers (headers)
    633   "Compute header list set with HEADERS.
    634 
    635 Evaluate all header arguments set to functions prior to returning
    636 the list of header arguments."
    637   (let ((lst nil))
    638     (dolist (elem headers)
    639       (if (and (cdr elem) (functionp (cdr elem)))
    640           (push `(,(car elem) . ,(funcall (cdr elem))) lst)
    641         (push elem lst)))
    642     (reverse lst)))
    643 
    644 (defun org-babel-get-src-block-info (&optional no-eval datum)
    645   "Extract information from a source block or inline source block.
    646 
    647 When optional argument NO-EVAL is non-nil, Babel does not resolve
    648 remote variable references; a process which could likely result
    649 in the execution of other code blocks, and do not evaluate Lisp
    650 values in parameters.
    651 
    652 By default, consider the block at point.  However, when optional
    653 argument DATUM is provided, extract information from that parsed
    654 object instead.
    655 
    656 Return nil if point is not on a source block.  Otherwise, return
    657 a list with the following pattern:
    658 
    659   (language body arguments switches name start coderef)"
    660   (let* ((datum (or datum (org-element-context)))
    661 	 (type (org-element-type datum))
    662 	 (inline (eq type 'inline-src-block)))
    663     (when (memq type '(inline-src-block src-block))
    664       (let* ((lang (org-element-property :language datum))
    665 	     (lang-headers (intern
    666 			    (concat "org-babel-default-header-args:" lang)))
    667 	     (name (org-element-property :name datum))
    668 	     (info
    669 	      (list
    670 	       lang
    671 	       (org-babel--normalize-body datum)
    672 	       (apply #'org-babel-merge-params
    673 		      (if inline org-babel-default-inline-header-args
    674 			org-babel-default-header-args)
    675 		      (and (boundp lang-headers) (eval lang-headers t))
    676 		      (append
    677 		       ;; If DATUM is provided, make sure we get node
    678 		       ;; properties applicable to its location within
    679 		       ;; the document.
    680 		       (org-with-point-at (org-element-property :begin datum)
    681 			 (org-babel-params-from-properties lang no-eval))
    682 		       (mapcar (lambda (h)
    683 				 (org-babel-parse-header-arguments h no-eval))
    684 			       (cons (org-element-property :parameters datum)
    685 				     (org-element-property :header datum)))))
    686 	       (or (org-element-property :switches datum) "")
    687 	       name
    688 	       (org-element-property (if inline :begin :post-affiliated)
    689 				     datum)
    690 	       (and (not inline) (org-src-coderef-format datum)))))
    691 	(unless no-eval
    692 	  (setf (nth 2 info) (org-babel-process-params (nth 2 info))))
    693 	(setf (nth 2 info) (org-babel-generate-file-param name (nth 2 info)))
    694 	info))))
    695 
    696 (defun org-babel--expand-body (info)
    697   "Expand noweb references in body and remove any coderefs."
    698   (let ((coderef (nth 6 info))
    699 	(expand
    700 	 (if (org-babel-noweb-p (nth 2 info) :eval)
    701 	     (org-babel-expand-noweb-references info)
    702 	   (nth 1 info))))
    703     (if (not coderef) expand
    704       (replace-regexp-in-string
    705        (org-src-coderef-regexp coderef) "" expand nil nil 1))))
    706 
    707 (defun org-babel--file-desc (params result)
    708   "Retrieve file description."
    709   (pcase (assq :file-desc params)
    710     (`nil nil)
    711     (`(:file-desc) result)
    712     (`(:file-desc . ,(and (pred stringp) val)) val)))
    713 
    714 (defvar *this*) ; Dynamically bound in `org-babel-execute-src-block'
    715                 ; and `org-babel-read'
    716 
    717 ;;;###autoload
    718 (defun org-babel-execute-src-block (&optional arg info params executor-type)
    719   "Execute the current source code block and return the result.
    720 Insert the results of execution into the buffer.  Source code
    721 execution and the collection and formatting of results can be
    722 controlled through a variety of header arguments.
    723 
    724 With prefix argument ARG, force re-execution even if an existing
    725 result cached in the buffer would otherwise have been returned.
    726 
    727 Optionally supply a value for INFO in the form returned by
    728 `org-babel-get-src-block-info'.
    729 
    730 Optionally supply a value for PARAMS which will be merged with
    731 the header arguments specified at the front of the source code
    732 block.
    733 
    734 EXECUTOR-TYPE is the type of the org element responsible for the
    735 execution of the source block.  If not provided then informed
    736 guess will be made."
    737   (interactive)
    738   (let* ((org-babel-current-src-block-location
    739           (or org-babel-current-src-block-location
    740               (nth 5 info)
    741               (org-babel-where-is-src-block-head)))
    742          (info (if info (copy-tree info) (org-babel-get-src-block-info)))
    743          (executor-type
    744           (or executor-type
    745               ;; If `executor-type' is unset, then we will make an
    746               ;; informed guess.
    747               (pcase (and
    748                       ;; When executing virtual src block, no location
    749                       ;; is known.
    750                       org-babel-current-src-block-location
    751                       (char-after org-babel-current-src-block-location))
    752                 (?s 'inline-src-block)
    753                 (?c 'inline-babel-call)
    754                 (?# (pcase (char-after (+ 2 org-babel-current-src-block-location))
    755                       (?b 'src-block)
    756                       (?c 'call-block)
    757                       (_ 'unknown)))
    758                 (_ 'unknown)))))
    759     ;; Merge PARAMS with INFO before considering source block
    760     ;; evaluation since both could disagree.
    761     (cl-callf org-babel-merge-params (nth 2 info) params)
    762     (when (org-babel-check-evaluate info)
    763       (cl-callf org-babel-process-params (nth 2 info))
    764       (let* ((params (nth 2 info))
    765 	     (cache (let ((c (cdr (assq :cache params))))
    766 		      (and (not arg) c (string= "yes" c))))
    767 	     (new-hash (and cache (org-babel-sha1-hash info :eval)))
    768 	     (old-hash (and cache (org-babel-current-result-hash)))
    769 	     (current-cache (and new-hash (equal new-hash old-hash))))
    770 	(cond
    771 	 (current-cache
    772 	  (save-excursion		;Return cached result.
    773 	    (goto-char (org-babel-where-is-src-block-result nil info))
    774 	    (forward-line)
    775 	    (skip-chars-forward " \t")
    776 	    (let ((result (org-babel-read-result)))
    777 	      (message (format "Cached: %s"
    778                                (replace-regexp-in-string "%" "%%" (format "%S" result))))
    779 	      result)))
    780 	 ((org-babel-confirm-evaluate info)
    781 	  (let* ((lang (nth 0 info))
    782 		 (result-params (cdr (assq :result-params params)))
    783 		 (body (org-babel--expand-body info))
    784 		 (dir (cdr (assq :dir params)))
    785 		 (mkdirp (cdr (assq :mkdirp params)))
    786 		 (default-directory
    787 		   (cond
    788 		    ((not dir) default-directory)
    789 		    ((member mkdirp '("no" "nil" nil))
    790 		     (file-name-as-directory (expand-file-name dir)))
    791 		    (t
    792 		     (let ((d (file-name-as-directory (expand-file-name dir))))
    793 		       (make-directory d 'parents)
    794 		       d))))
    795 		 (cmd (intern (concat "org-babel-execute:" lang)))
    796 		 result exec-start-time)
    797 	    (unless (fboundp cmd)
    798 	      (error "No org-babel-execute function for %s!" lang))
    799 	    (message "Executing %s %s %s..."
    800 		     (capitalize lang)
    801                      (pcase executor-type
    802                        ('src-block "code block")
    803                        ('inline-src-block "inline code block")
    804                        ('babel-call "call")
    805                        ('inline-babel-call "inline call")
    806                        (e (symbol-name e)))
    807 		     (let ((name (nth 4 info)))
    808 		       (if name
    809                            (format "(%s)" name)
    810                          (format "at position %S" (nth 5 info)))))
    811 	    (setq exec-start-time (current-time)
    812                   result
    813 		  (let ((r (save-current-buffer (funcall cmd body params))))
    814 		    (if (and (eq (cdr (assq :result-type params)) 'value)
    815 			     (or (member "vector" result-params)
    816 				 (member "table" result-params))
    817 			     (not (listp r)))
    818 			(list (list r))
    819 		      r)))
    820 	    (let ((file (and (member "file" result-params)
    821 			     (cdr (assq :file params)))))
    822 	      ;; If non-empty result and :file then write to :file.
    823 	      (when file
    824 		;; If `:results' are special types like `link' or
    825 		;; `graphics', don't write result to `:file'.  Only
    826 		;; insert a link to `:file'.
    827 		(when (and result
    828 			   (not (or (member "link" result-params)
    829 				  (member "graphics" result-params))))
    830 		  (with-temp-file file
    831 		    (insert (org-babel-format-result
    832 			     result
    833 			     (cdr (assq :sep params)))))
    834 		  ;; Set file permissions if header argument
    835 		  ;; `:file-mode' is provided.
    836 		  (when (assq :file-mode params)
    837 		    (set-file-modes file (cdr (assq :file-mode params)))))
    838 		(setq result file))
    839 	      ;; Possibly perform post process provided its
    840 	      ;; appropriate.  Dynamically bind "*this*" to the
    841 	      ;; actual results of the block.
    842 	      (let ((post (cdr (assq :post params))))
    843 		(when post
    844 		  (let ((*this* (if (not file) result
    845 				  (org-babel-result-to-file
    846 				   file
    847 				   (org-babel--file-desc params result)
    848                                    'attachment))))
    849 		    (setq result (org-babel-ref-resolve post))
    850 		    (when file
    851 		      (setq result-params (remove "file" result-params))))))
    852 	      (if (member "none" result-params)
    853 		  (message "result silenced")
    854 	        (org-babel-insert-result
    855 	         result result-params info new-hash lang
    856                  (time-subtract (current-time) exec-start-time))))
    857 	    (run-hooks 'org-babel-after-execute-hook)
    858 	    result)))))))
    859 
    860 (defun org-babel-expand-body:generic (body params &optional var-lines)
    861   "Expand BODY with PARAMS.
    862 Expand a block of code with org-babel according to its header
    863 arguments.  This generic implementation of body expansion is
    864 called for languages which have not defined their own specific
    865 org-babel-expand-body:lang function."
    866   (let ((pro (cdr (assq :prologue params)))
    867 	(epi (cdr (assq :epilogue params))))
    868     (mapconcat #'identity
    869 	       (append (when pro (list pro))
    870 		       var-lines
    871 		       (list body)
    872 		       (when epi (list epi)))
    873 	       "\n")))
    874 
    875 ;;;###autoload
    876 (defun org-babel-expand-src-block (&optional _arg info params)
    877   "Expand the current source code block.
    878 Expand according to the source code block's header
    879 arguments and pop open the results in a preview buffer."
    880   (interactive)
    881   (let* ((info (or info (org-babel-get-src-block-info)))
    882          (lang (nth 0 info))
    883 	 (params (setf (nth 2 info)
    884                        (sort (org-babel-merge-params (nth 2 info) params)
    885                              (lambda (el1 el2) (string< (symbol-name (car el1))
    886 							(symbol-name (car el2)))))))
    887          (body (setf (nth 1 info)
    888 		     (if (org-babel-noweb-p params :eval)
    889 			 (org-babel-expand-noweb-references info) (nth 1 info))))
    890          (expand-cmd (intern (concat "org-babel-expand-body:" lang)))
    891 	 (assignments-cmd (intern (concat "org-babel-variable-assignments:"
    892 					  lang)))
    893          (expanded
    894 	  (if (fboundp expand-cmd) (funcall expand-cmd body params)
    895 	    (org-babel-expand-body:generic
    896 	     body params (and (fboundp assignments-cmd)
    897 			      (funcall assignments-cmd params))))))
    898     (if (called-interactively-p 'any)
    899 	(org-edit-src-code
    900 	 expanded (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*"))
    901       expanded)))
    902 
    903 (defun org-babel-combine-header-arg-lists (original &rest others)
    904   "Combine a number of lists of header argument names and arguments."
    905   (let ((results (copy-sequence original)))
    906     (dolist (new-list others)
    907       (dolist (arg-pair new-list)
    908 	(let ((header (car arg-pair)))
    909 	  (setq results
    910 		(cons arg-pair (cl-remove-if
    911 				(lambda (pair) (equal header (car pair)))
    912 				results))))))
    913     results))
    914 
    915 ;;;###autoload
    916 (defun org-babel-check-src-block ()
    917   "Check for misspelled header arguments in the current code block."
    918   (interactive)
    919   ;; TODO: report malformed code block
    920   ;; TODO: report incompatible combinations of header arguments
    921   ;; TODO: report uninitialized variables
    922   (let ((too-close 2) ;; <- control closeness to report potential match
    923 	(names (mapcar #'symbol-name org-babel-header-arg-names)))
    924     (dolist (header (mapcar (lambda (arg) (substring (symbol-name (car arg)) 1))
    925 			    (and (org-babel-where-is-src-block-head)
    926 				 (org-babel-parse-header-arguments
    927 				  (org-no-properties
    928 				   (match-string 4))))))
    929       (dolist (name names)
    930 	(when (and (not (string= header name))
    931 		   (<= (org-string-distance header name) too-close)
    932 		   (not (member header names)))
    933 	  (error "Supplied header \"%S\" is suspiciously close to \"%S\""
    934 		 header name))))
    935     (message "No suspicious header arguments found.")))
    936 
    937 ;;;###autoload
    938 (defun org-babel-insert-header-arg (&optional header-arg value)
    939   "Insert a header argument selecting from lists of common args and values."
    940   (interactive)
    941   (let* ((info (org-babel-get-src-block-info 'no-eval))
    942 	 (lang (car info))
    943 	 (begin (nth 5 info))
    944 	 (lang-headers (intern (concat "org-babel-header-args:" lang)))
    945 	 (headers (org-babel-combine-header-arg-lists
    946 		   org-babel-common-header-args-w-values
    947 		   (when (boundp lang-headers) (eval lang-headers t))))
    948 	 (header-arg (or header-arg
    949 			 (completing-read
    950 			  "Header Arg: "
    951 			  (mapcar
    952 			   (lambda (header-spec) (symbol-name (car header-spec)))
    953 			   headers))))
    954 	 (vals (cdr (assoc (intern header-arg) headers)))
    955 	 (value (or value
    956 		    (cond
    957 		     ((eq vals :any)
    958 		      (read-from-minibuffer "value: "))
    959 		     ((listp vals)
    960 		      (mapconcat
    961 		       (lambda (group)
    962 			 (let ((arg (completing-read
    963 				     "Value: "
    964 				     (cons "default"
    965 					   (mapcar #'symbol-name group)))))
    966 			   (if (and arg (not (string= "default" arg)))
    967 			       (concat arg " ")
    968 			     "")))
    969 		       vals ""))))))
    970     (save-excursion
    971       (goto-char begin)
    972       (goto-char (line-end-position))
    973       (unless (= (char-before (point)) ?\ ) (insert " "))
    974       (insert ":" header-arg) (when value (insert " " value)))))
    975 
    976 ;; Add support for completing-read insertion of header arguments after ":"
    977 (defun org-babel-header-arg-expand ()
    978   "Call `org-babel-enter-header-arg-w-completion' in appropriate contexts."
    979   (when (and (equal (char-before) ?\:) (org-babel-where-is-src-block-head))
    980     (org-babel-enter-header-arg-w-completion (match-string 2))))
    981 
    982 (defun org-babel-enter-header-arg-w-completion (&optional lang)
    983   "Insert header argument appropriate for LANG with completion."
    984   (let* ((lang-headers-var (intern (concat "org-babel-header-args:" lang)))
    985          (lang-headers (when (boundp lang-headers-var) (eval lang-headers-var t)))
    986 	 (headers-w-values (org-babel-combine-header-arg-lists
    987 			    org-babel-common-header-args-w-values lang-headers))
    988          (headers (mapcar #'symbol-name (mapcar #'car headers-w-values)))
    989          (header (org-completing-read "Header Arg: " headers))
    990          (args (cdr (assoc (intern header) headers-w-values)))
    991          (arg (when (and args (listp args))
    992                 (org-completing-read
    993                  (format "%s: " header)
    994                  (mapcar #'symbol-name (apply #'append args))))))
    995     (insert (concat header " " (or arg "")))
    996     (cons header arg)))
    997 
    998 (add-hook 'org-cycle-tab-first-hook 'org-babel-header-arg-expand)
    999 
   1000 ;;;###autoload
   1001 (defun org-babel-load-in-session (&optional _arg info)
   1002   "Load the body of the current source-code block.
   1003 Evaluate the header arguments for the source block before
   1004 entering the session.  After loading the body this pops open the
   1005 session."
   1006   (interactive)
   1007   (let* ((info (or info (org-babel-get-src-block-info)))
   1008          (lang (nth 0 info))
   1009          (params (nth 2 info))
   1010          (body (if (not info)
   1011 		   (user-error "No src code block at point")
   1012 		 (setf (nth 1 info)
   1013 		       (if (org-babel-noweb-p params :eval)
   1014 			   (org-babel-expand-noweb-references info)
   1015 			 (nth 1 info)))))
   1016          (session (cdr (assq :session params)))
   1017 	 (dir (cdr (assq :dir params)))
   1018 	 (default-directory
   1019 	   (or (and dir (file-name-as-directory dir)) default-directory))
   1020 	 (cmd (intern (concat "org-babel-load-session:" lang))))
   1021     (unless (fboundp cmd)
   1022       (error "No org-babel-load-session function for %s!" lang))
   1023     (pop-to-buffer (funcall cmd session body params))
   1024     (end-of-line 1)))
   1025 
   1026 ;;;###autoload
   1027 (defun org-babel-initiate-session (&optional arg info)
   1028   "Initiate session for current code block.
   1029 If called with a prefix argument then resolve any variable
   1030 references in the header arguments and assign these variables in
   1031 the session.  Copy the body of the code block to the kill ring."
   1032   (interactive "P")
   1033   (let* ((info (or info (org-babel-get-src-block-info (not arg))))
   1034          (lang (nth 0 info))
   1035          (body (nth 1 info))
   1036          (params (nth 2 info))
   1037          (session (cdr (assq :session params)))
   1038 	 (dir (cdr (assq :dir params)))
   1039 	 (default-directory
   1040 	   (or (and dir (file-name-as-directory dir)) default-directory))
   1041 	 (init-cmd (intern (format "org-babel-%s-initiate-session" lang)))
   1042 	 (prep-cmd (intern (concat "org-babel-prep-session:" lang))))
   1043     (when (and (stringp session) (string= session "none"))
   1044       (error "This block is not using a session!"))
   1045     (unless (fboundp init-cmd)
   1046       (error "No org-babel-initiate-session function for %s!" lang))
   1047     (with-temp-buffer (insert (org-trim body))
   1048                       (copy-region-as-kill (point-min) (point-max)))
   1049     (when arg
   1050       (unless (fboundp prep-cmd)
   1051 	(error "No org-babel-prep-session function for %s!" lang))
   1052       (funcall prep-cmd session params))
   1053     (funcall init-cmd session params)))
   1054 
   1055 ;;;###autoload
   1056 (defun org-babel-switch-to-session (&optional arg info)
   1057   "Switch to the session of the current code block.
   1058 Uses `org-babel-initiate-session' to start the session.  If called
   1059 with a prefix argument then this is passed on to
   1060 `org-babel-initiate-session'."
   1061   (interactive "P")
   1062   (pop-to-buffer (org-babel-initiate-session arg info))
   1063   (end-of-line 1))
   1064 
   1065 (defalias 'org-babel-pop-to-session 'org-babel-switch-to-session)
   1066 
   1067 (defvar org-src-window-setup)
   1068 
   1069 ;;;###autoload
   1070 (defun org-babel-switch-to-session-with-code (&optional arg _info)
   1071   "Switch to code buffer and display session."
   1072   (interactive "P")
   1073   (let ((swap-windows
   1074 	 (lambda ()
   1075 	   (let ((other-window-buffer (window-buffer (next-window))))
   1076 	     (set-window-buffer (next-window) (current-buffer))
   1077 	     (set-window-buffer (selected-window) other-window-buffer))
   1078 	   (other-window 1)))
   1079 	(info (org-babel-get-src-block-info))
   1080 	(org-src-window-setup 'reorganize-frame))
   1081     (save-excursion
   1082       (org-babel-switch-to-session arg info))
   1083     (org-edit-src-code)
   1084     (funcall swap-windows)))
   1085 
   1086 ;;;###autoload
   1087 (defmacro org-babel-do-in-edit-buffer (&rest body)
   1088   "Evaluate BODY in edit buffer if there is a code block at point.
   1089 Return t if a code block was found at point, nil otherwise."
   1090   (declare (debug (body)))
   1091   `(let* ((element (org-element-at-point))
   1092 	  ;; This function is not supposed to move point.  However,
   1093 	  ;; `org-edit-src-code' always moves point back into the
   1094 	  ;; source block.  It is problematic if the point was before
   1095 	  ;; the code, e.g., on block's opening line.  In this case,
   1096 	  ;; we want to restore this location after executing BODY.
   1097 	  (outside-position
   1098 	   (and (<= (line-beginning-position)
   1099 		    (org-element-property :post-affiliated element))
   1100 		(point-marker)))
   1101 	  (org-src-window-setup 'switch-invisibly))
   1102      (when (and (org-babel-where-is-src-block-head element)
   1103 		(org-edit-src-code))
   1104        (unwind-protect (progn ,@body)
   1105 	 (org-edit-src-exit)
   1106 	 (when outside-position (goto-char outside-position)))
   1107        t)))
   1108 
   1109 (defun org-babel-do-key-sequence-in-edit-buffer (key)
   1110   "Read key sequence and execute the command in edit buffer.
   1111 Enter a key sequence to be executed in the language major-mode
   1112 edit buffer.  For example, TAB will alter the contents of the
   1113 Org code block according to the effect of TAB in the language
   1114 major mode buffer.  For languages that support interactive
   1115 sessions, this can be used to send code from the Org buffer
   1116 to the session for evaluation using the native major mode
   1117 evaluation mechanisms."
   1118   (interactive "kEnter key-sequence to execute in edit buffer: ")
   1119   (org-babel-do-in-edit-buffer
   1120    (call-interactively
   1121     (key-binding (or key (read-key-sequence nil))))))
   1122 
   1123 (defvar org-link-bracket-re)
   1124 
   1125 (defun org-babel-active-location-p ()
   1126   (memq (org-element-type (save-match-data (org-element-context)))
   1127 	'(babel-call inline-babel-call inline-src-block src-block)))
   1128 
   1129 ;;;###autoload
   1130 (defun org-babel-open-src-block-result (&optional re-run)
   1131   "Open results of source block at point.
   1132 
   1133 If `point' is on a source block then open the results of the source
   1134 code block, otherwise return nil.  With optional prefix argument
   1135 RE-RUN the source-code block is evaluated even if results already
   1136 exist."
   1137   (interactive "P")
   1138   (pcase (org-babel-get-src-block-info 'no-eval)
   1139     (`(,_ ,_ ,arguments ,_ ,_ ,start ,_)
   1140      (save-excursion
   1141        ;; Go to the results, if there aren't any then run the block.
   1142        (goto-char start)
   1143        (goto-char (or (and (not re-run) (org-babel-where-is-src-block-result))
   1144 		      (progn (org-babel-execute-src-block)
   1145 			     (org-babel-where-is-src-block-result))))
   1146        (end-of-line)
   1147        (skip-chars-forward " \r\t\n")
   1148        ;; Open the results.
   1149        (if (looking-at org-link-bracket-re) (org-open-at-point)
   1150 	 (let ((r (org-babel-format-result (org-babel-read-result)
   1151 					   (cdr (assq :sep arguments)))))
   1152 	   (pop-to-buffer (get-buffer-create "*Org Babel Results*"))
   1153 	   (erase-buffer)
   1154 	   (insert r)))
   1155        t))
   1156     (_ nil)))
   1157 
   1158 ;;;###autoload
   1159 (defmacro org-babel-map-src-blocks (file &rest body)
   1160   "Evaluate BODY forms on each source-block in FILE.
   1161 If FILE is nil evaluate BODY forms on source blocks in current
   1162 buffer.  During evaluation of BODY the following local variables
   1163 are set relative to the currently matched code block.
   1164 
   1165 full-block ------- string holding the entirety of the code block
   1166 beg-block -------- point at the beginning of the code block
   1167 end-block -------- point at the end of the matched code block
   1168 lang ------------- string holding the language of the code block
   1169 beg-lang --------- point at the beginning of the lang
   1170 end-lang --------- point at the end of the lang
   1171 switches --------- string holding the switches
   1172 beg-switches ----- point at the beginning of the switches
   1173 end-switches ----- point at the end of the switches
   1174 header-args ------ string holding the header-args
   1175 beg-header-args -- point at the beginning of the header-args
   1176 end-header-args -- point at the end of the header-args
   1177 body ------------- string holding the body of the code block
   1178 beg-body --------- point at the beginning of the body
   1179 end-body --------- point at the end of the body"
   1180   (declare (indent 1) (debug t))
   1181   (let ((tempvar (make-symbol "file")))
   1182     `(let* ((case-fold-search t)
   1183 	    (,tempvar ,file)
   1184 	    (visited-p (or (null ,tempvar)
   1185 			   (get-file-buffer (expand-file-name ,tempvar))))
   1186 	    (point (point)) to-be-removed)
   1187        (save-window-excursion
   1188 	 (when ,tempvar (find-file ,tempvar))
   1189 	 (setq to-be-removed (current-buffer))
   1190 	 (goto-char (point-min))
   1191 	 (while (re-search-forward org-babel-src-block-regexp nil t)
   1192 	   (when (org-babel-active-location-p)
   1193 	     (goto-char (match-beginning 0))
   1194 	     (let ((full-block (match-string 0))
   1195 		   (beg-block (match-beginning 0))
   1196 		   (end-block (match-end 0))
   1197 		   (lang (match-string 2))
   1198 		   (beg-lang (match-beginning 2))
   1199 		   (end-lang (match-end 2))
   1200 		   (switches (match-string 3))
   1201 		   (beg-switches (match-beginning 3))
   1202 		   (end-switches (match-end 3))
   1203 		   (header-args (match-string 4))
   1204 		   (beg-header-args (match-beginning 4))
   1205 		   (end-header-args (match-end 4))
   1206 		   (body (match-string 5))
   1207 		   (beg-body (match-beginning 5))
   1208 		   (end-body (match-end 5)))
   1209                ;; Silence byte-compiler in case `body' doesn't use all
   1210                ;; those variables.
   1211                (ignore full-block beg-block end-block lang
   1212                        beg-lang end-lang switches beg-switches
   1213                        end-switches header-args beg-header-args
   1214                        end-header-args body beg-body end-body)
   1215                ,@body
   1216 	       (goto-char end-block)))))
   1217        (unless visited-p (kill-buffer to-be-removed))
   1218        (goto-char point))))
   1219 
   1220 ;;;###autoload
   1221 (defmacro org-babel-map-inline-src-blocks (file &rest body)
   1222   "Evaluate BODY forms on each inline source block in FILE.
   1223 If FILE is nil evaluate BODY forms on source blocks in current
   1224 buffer."
   1225   (declare (indent 1) (debug (form body)))
   1226   (org-with-gensyms (datum end point tempvar to-be-removed visitedp)
   1227     `(let* ((case-fold-search t)
   1228 	    (,tempvar ,file)
   1229 	    (,visitedp (or (null ,tempvar)
   1230 			   (get-file-buffer (expand-file-name ,tempvar))))
   1231 	    (,point (point))
   1232 	    ,to-be-removed)
   1233        (save-window-excursion
   1234 	 (when ,tempvar (find-file ,tempvar))
   1235 	 (setq ,to-be-removed (current-buffer))
   1236 	 (goto-char (point-min))
   1237 	 (while (re-search-forward "src_\\S-" nil t)
   1238 	   (let ((,datum (save-match-data (org-element-context))))
   1239 	     (when (eq (org-element-type ,datum) 'inline-src-block)
   1240 	       (goto-char (match-beginning 0))
   1241 	       (let ((,end (copy-marker (org-element-property :end ,datum))))
   1242 		 ,@body
   1243 		 (goto-char ,end)
   1244 		 (set-marker ,end nil))))))
   1245        (unless ,visitedp (kill-buffer ,to-be-removed))
   1246        (goto-char ,point))))
   1247 
   1248 ;;;###autoload
   1249 (defmacro org-babel-map-call-lines (file &rest body)
   1250   "Evaluate BODY forms on each call line in FILE.
   1251 If FILE is nil evaluate BODY forms on source blocks in current
   1252 buffer."
   1253   (declare (indent 1) (debug (form body)))
   1254   (org-with-gensyms (datum end point tempvar to-be-removed visitedp)
   1255     `(let* ((case-fold-search t)
   1256 	    (,tempvar ,file)
   1257 	    (,visitedp (or (null ,tempvar)
   1258 			   (get-file-buffer (expand-file-name ,tempvar))))
   1259 	    (,point (point))
   1260 	    ,to-be-removed)
   1261        (save-window-excursion
   1262 	 (when ,tempvar (find-file ,tempvar))
   1263 	 (setq ,to-be-removed (current-buffer))
   1264 	 (goto-char (point-min))
   1265 	 (while (re-search-forward "call_\\S-\\|^[ \t]*#\\+CALL:" nil t)
   1266 	   (let ((,datum (save-match-data (org-element-context))))
   1267 	     (when (memq (org-element-type ,datum)
   1268 			 '(babel-call inline-babel-call))
   1269 	       (goto-char (match-beginning 0))
   1270 	       (let ((,end (copy-marker (org-element-property :end ,datum))))
   1271 		 ,@body
   1272 		 (goto-char ,end)
   1273 		 (set-marker ,end nil))))))
   1274        (unless ,visitedp (kill-buffer ,to-be-removed))
   1275        (goto-char ,point))))
   1276 
   1277 ;;;###autoload
   1278 (defmacro org-babel-map-executables (file &rest body)
   1279   "Evaluate BODY forms on each active Babel code in FILE.
   1280 If FILE is nil evaluate BODY forms on source blocks in current
   1281 buffer."
   1282   (declare (indent 1) (debug (form body)))
   1283   (org-with-gensyms (datum end point tempvar to-be-removed visitedp)
   1284     `(let* ((case-fold-search t)
   1285 	    (,tempvar ,file)
   1286 	    (,visitedp (or (null ,tempvar)
   1287 			   (get-file-buffer (expand-file-name ,tempvar))))
   1288 	    (,point (point))
   1289 	    ,to-be-removed)
   1290        (save-window-excursion
   1291 	 (when ,tempvar (find-file ,tempvar))
   1292 	 (setq ,to-be-removed (current-buffer))
   1293 	 (goto-char (point-min))
   1294 	 (while (re-search-forward
   1295 		 "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)" nil t)
   1296 	   (let ((,datum (save-match-data (org-element-context))))
   1297 	     (when (memq (org-element-type ,datum)
   1298 			 '(babel-call inline-babel-call inline-src-block
   1299 				      src-block))
   1300 	       (goto-char (match-beginning 0))
   1301 	       (let ((,end (copy-marker (org-element-property :end ,datum))))
   1302 		 ,@body
   1303 		 (goto-char ,end)
   1304 		 (set-marker ,end nil))))))
   1305        (unless ,visitedp (kill-buffer ,to-be-removed))
   1306        (goto-char ,point))))
   1307 
   1308 ;;;###autoload
   1309 (defun org-babel-execute-buffer (&optional arg)
   1310   "Execute source code blocks in a buffer.
   1311 Call `org-babel-execute-src-block' on every source block in
   1312 the current buffer."
   1313   (interactive "P")
   1314   (org-babel-eval-wipe-error-buffer)
   1315   (org-save-outline-visibility t
   1316     (org-babel-map-executables nil
   1317       (if (memq (org-element-type (org-element-context))
   1318 		'(babel-call inline-babel-call))
   1319           (org-babel-lob-execute-maybe)
   1320         (org-babel-execute-src-block arg)))))
   1321 
   1322 ;;;###autoload
   1323 (defun org-babel-execute-subtree (&optional arg)
   1324   "Execute source code blocks in a subtree.
   1325 Call `org-babel-execute-src-block' on every source block in
   1326 the current subtree."
   1327   (interactive "P")
   1328   (save-restriction
   1329     (save-excursion
   1330       (org-narrow-to-subtree)
   1331       (org-babel-execute-buffer arg)
   1332       (widen))))
   1333 
   1334 ;;;###autoload
   1335 (defun org-babel-sha1-hash (&optional info context)
   1336   "Generate a sha1 hash based on the value of INFO.
   1337 CONTEXT specifies the context of evaluation.  It can be `:eval',
   1338 `:export', `:tangle'.  A nil value means `:eval'."
   1339   (interactive)
   1340   (let ((print-level nil)
   1341 	(info (or info (org-babel-get-src-block-info)))
   1342 	(context (or context :eval)))
   1343     (setf (nth 2 info)
   1344 	  (sort (copy-sequence (nth 2 info))
   1345 		(lambda (a b) (string< (car a) (car b)))))
   1346     (let* ((rm (lambda (lst)
   1347 		 (dolist (p '("replace" "silent" "none"
   1348 			      "discard" "append" "prepend"))
   1349 		   (setq lst (remove p lst)))
   1350 		 lst))
   1351 	   (norm (lambda (arg)
   1352 		   (let ((v (if (and (listp (cdr arg)) (null (cddr arg)))
   1353 				(copy-sequence (cdr arg))
   1354 			      (cdr arg))))
   1355 		     (when (and v (not (and (sequencep v)
   1356 					  (not (consp v))
   1357 					  (= (length v) 0))))
   1358 		       (cond
   1359 			((and (listp v) ; lists are sorted
   1360 			      (member (car arg) '(:result-params)))
   1361 			 (sort (funcall rm v) #'string<))
   1362 			((and (stringp v) ; strings are sorted
   1363 			      (member (car arg) '(:results :exports)))
   1364 			 (mapconcat #'identity (sort (funcall rm (split-string v))
   1365 						     #'string<) " "))
   1366 			(t v))))))
   1367 	   ;; expanded body
   1368 	   (lang (nth 0 info))
   1369 	   (params (nth 2 info))
   1370 	   (body (if (org-babel-noweb-p params context)
   1371 		     (org-babel-expand-noweb-references info)
   1372 		   (nth 1 info)))
   1373 	   (expand-cmd (intern (concat "org-babel-expand-body:" lang)))
   1374 	   (assignments-cmd (intern (concat "org-babel-variable-assignments:"
   1375 					    lang)))
   1376 	   (expanded
   1377 	    (if (fboundp expand-cmd) (funcall expand-cmd body params)
   1378 	      (org-babel-expand-body:generic
   1379 	       body params (and (fboundp assignments-cmd)
   1380 				(funcall assignments-cmd params))))))
   1381       (let* ((it (format "%s-%s"
   1382                          (mapconcat
   1383                           #'identity
   1384                           (delq nil (mapcar (lambda (arg)
   1385                                             (let ((normalized (funcall norm arg)))
   1386                                               (when normalized
   1387                                                 (format "%S" normalized))))
   1388                                           (nth 2 info))) ":")
   1389                          expanded))
   1390              (hash (sha1 it)))
   1391         (when (called-interactively-p 'interactive) (message hash))
   1392         hash))))
   1393 
   1394 (defun org-babel-current-result-hash (&optional info)
   1395   "Return the current in-buffer hash."
   1396   (let ((result (org-babel-where-is-src-block-result nil info)))
   1397     (when result
   1398       (org-with-point-at result
   1399 	(let ((case-fold-search t)) (looking-at org-babel-result-regexp))
   1400 	(match-string-no-properties 1)))))
   1401 
   1402 (defun org-babel-hide-hash ()
   1403   "Hide the hash in the current results line.
   1404 Only the initial `org-babel-hash-show' characters of the hash
   1405 will remain visible."
   1406   (add-to-invisibility-spec '(org-babel-hide-hash . t))
   1407   (save-excursion
   1408     (when (and (let ((case-fold-search t))
   1409 		 (re-search-forward org-babel-result-regexp nil t))
   1410                (match-string 1))
   1411       (let* ((start (match-beginning 1))
   1412              (hide-start (+ org-babel-hash-show start))
   1413              (end (match-end 1))
   1414              (hash (match-string 1))
   1415              ov1 ov2)
   1416         (setq ov1 (make-overlay start hide-start))
   1417         (setq ov2 (make-overlay hide-start end))
   1418         (overlay-put ov2 'invisible 'org-babel-hide-hash)
   1419         (overlay-put ov1 'babel-hash hash)))))
   1420 
   1421 (defun org-babel-hide-all-hashes ()
   1422   "Hide the hash in the current buffer.
   1423 Only the initial `org-babel-hash-show' characters of each hash
   1424 will remain visible.  This function should be called as part of
   1425 the `org-mode-hook'."
   1426   (save-excursion
   1427     (let ((case-fold-search t))
   1428       (while (and (not org-babel-hash-show-time)
   1429 		  (re-search-forward org-babel-result-regexp nil t))
   1430 	(goto-char (match-beginning 0))
   1431 	(org-babel-hide-hash)
   1432 	(goto-char (match-end 0))))))
   1433 (add-hook 'org-mode-hook #'org-babel-hide-all-hashes)
   1434 
   1435 (defun org-babel-hash-at-point (&optional point)
   1436   "Return the value of the hash at POINT.
   1437 \\<org-mode-map>\
   1438 The hash is also added as the last element of the kill ring.
   1439 This can be called with `\\[org-ctrl-c-ctrl-c]'."
   1440   (interactive)
   1441   (let ((hash (car (delq nil (mapcar
   1442 			      (lambda (ol) (overlay-get ol 'babel-hash))
   1443                               (overlays-at (or point (point))))))))
   1444     (when hash (kill-new hash) (message hash))))
   1445 
   1446 (defun org-babel-result-hide-spec ()
   1447   "Hide portions of results lines.
   1448 Add `org-babel-hide-result' as an invisibility spec for hiding
   1449 portions of results lines."
   1450   (add-to-invisibility-spec '(org-babel-hide-result . t)))
   1451 (add-hook 'org-mode-hook #'org-babel-result-hide-spec)
   1452 
   1453 (defvar org-babel-hide-result-overlays nil
   1454   "Overlays hiding results.")
   1455 
   1456 (defun org-babel-result-hide-all ()
   1457   "Fold all results in the current buffer."
   1458   (interactive)
   1459   (org-babel-show-result-all)
   1460   (save-excursion
   1461     (let ((case-fold-search t))
   1462       (while (re-search-forward org-babel-result-regexp nil t)
   1463 	(save-excursion (goto-char (match-beginning 0))
   1464 			(org-babel-hide-result-toggle-maybe))))))
   1465 
   1466 (defun org-babel-show-result-all ()
   1467   "Unfold all results in the current buffer."
   1468   (mapc 'delete-overlay org-babel-hide-result-overlays)
   1469   (setq org-babel-hide-result-overlays nil))
   1470 
   1471 ;;;###autoload
   1472 (defun org-babel-hide-result-toggle-maybe ()
   1473   "Toggle visibility of result at point."
   1474   (interactive)
   1475   (let ((case-fold-search t))
   1476     (and (org-match-line org-babel-result-regexp)
   1477          (progn (org-babel-hide-result-toggle) t))))
   1478 
   1479 (defun org-babel-hide-result-toggle (&optional force)
   1480   "Toggle the visibility of the current result."
   1481   (interactive)
   1482   (save-excursion
   1483     (beginning-of-line)
   1484     (let ((case-fold-search t))
   1485       (unless (re-search-forward org-babel-result-regexp nil t)
   1486 	(error "Not looking at a result line")))
   1487     (let ((start (progn (beginning-of-line 2) (1- (point))))
   1488 	  (end (progn
   1489 		 (while (looking-at org-babel-multi-line-header-regexp)
   1490 		   (forward-line 1))
   1491 		 (goto-char (1- (org-babel-result-end)))
   1492 		 (point)))
   1493 	  ov)
   1494       (if (memq t (mapcar (lambda (overlay)
   1495 			    (eq (overlay-get overlay 'invisible)
   1496 				'org-babel-hide-result))
   1497 			  (overlays-at start)))
   1498 	  (when (or (not force) (eq force 'off))
   1499 	    (mapc (lambda (ov)
   1500 		    (when (member ov org-babel-hide-result-overlays)
   1501 		      (setq org-babel-hide-result-overlays
   1502 			    (delq ov org-babel-hide-result-overlays)))
   1503 		    (when (eq (overlay-get ov 'invisible)
   1504 			      'org-babel-hide-result)
   1505 		      (delete-overlay ov)))
   1506 		  (overlays-at start)))
   1507 	(setq ov (make-overlay start end))
   1508 	(overlay-put ov 'invisible 'org-babel-hide-result)
   1509 	;; make the block accessible to isearch
   1510 	(overlay-put
   1511 	 ov 'isearch-open-invisible
   1512 	 (lambda (ov)
   1513 	   (when (member ov org-babel-hide-result-overlays)
   1514 	     (setq org-babel-hide-result-overlays
   1515 		   (delq ov org-babel-hide-result-overlays)))
   1516 	   (when (eq (overlay-get ov 'invisible)
   1517 		     'org-babel-hide-result)
   1518 	     (delete-overlay ov))))
   1519 	(push ov org-babel-hide-result-overlays)))))
   1520 
   1521 ;; org-tab-after-check-for-cycling-hook
   1522 (add-hook 'org-cycle-tab-first-hook #'org-babel-hide-result-toggle-maybe)
   1523 ;; Remove overlays when changing major mode
   1524 (add-hook 'org-mode-hook
   1525 	  (lambda () (add-hook 'change-major-mode-hook
   1526 			       #'org-babel-show-result-all 'append 'local)))
   1527 
   1528 (defun org-babel-params-from-properties (&optional lang no-eval)
   1529   "Retrieve source block parameters specified as properties.
   1530 
   1531 LANG is the language of the source block, as a string.  When
   1532 optional argument NO-EVAL is non-nil, do not evaluate Lisp values
   1533 in parameters.
   1534 
   1535 Return a list of association lists of source block parameters
   1536 specified in the properties of the current outline entry."
   1537   (save-match-data
   1538     (list
   1539      ;; Header arguments specified with the header-args property at
   1540      ;; point of call.
   1541      (org-babel-parse-header-arguments
   1542       (org-entry-get (point) "header-args" 'inherit)
   1543       no-eval)
   1544      ;; Language-specific header arguments at point of call.
   1545      (and lang
   1546 	  (org-babel-parse-header-arguments
   1547 	   (org-entry-get (point) (concat "header-args:" lang) 'inherit)
   1548 	   no-eval)))))
   1549 
   1550 (defun org-babel-balanced-split (string alts)
   1551   "Split STRING on instances of ALTS.
   1552 ALTS is a character, or cons of two character options where each
   1553 option may be either the numeric code of a single character or
   1554 a list of character alternatives.  For example, to split on
   1555 balanced instances of \"[ \t]:\", set ALTS to ((32 9) . 58)."
   1556   (with-temp-buffer
   1557     (insert string)
   1558     (goto-char (point-min))
   1559     (let ((splitp (lambda (past next)
   1560 		    ;; Non-nil when there should be a split after NEXT
   1561 		    ;; character. PAST is the character before NEXT.
   1562 		    (pcase alts
   1563 		      (`(,(and first (pred consp)) . ,(and second (pred consp)))
   1564 		       (and (memq past first) (memq next second)))
   1565 		      (`(,first . ,(and second (pred consp)))
   1566 		       (and (eq past first) (memq next second)))
   1567 		      (`(,(and first (pred consp)) . ,second)
   1568 		       (and (memq past first) (eq next second)))
   1569 		      (`(,first . ,second)
   1570 		       (and (eq past first) (eq next second)))
   1571 		      ((pred (eq next)) t)
   1572 		      (_ nil))))
   1573 	  (partial nil)
   1574 	  (result nil))
   1575       (while (not (eobp))
   1576         (cond
   1577 	 ((funcall splitp (char-before) (char-after))
   1578 	  ;; There is a split after point.  If ALTS is two-folds,
   1579 	  ;; remove last parsed character as it belongs to ALTS.
   1580 	  (when (consp alts) (pop partial))
   1581 	  ;; Include elements parsed so far in RESULTS and flush
   1582 	  ;; partial parsing.
   1583 	  (when partial
   1584 	    (push (apply #'string (nreverse partial)) result)
   1585 	    (setq partial nil))
   1586 	  (forward-char))
   1587 	 ((memq (char-after) '(?\( ?\[))
   1588 	  ;; Include everything between balanced brackets.
   1589 	  (let* ((origin (point))
   1590 		 (after (char-after))
   1591 		 (openings (list after)))
   1592 	    (forward-char)
   1593 	    (while (and openings (re-search-forward "[]()]" nil t))
   1594 	      (pcase (char-before)
   1595 		((and match (or ?\[ ?\()) (push match openings))
   1596 		(?\] (when (eq ?\[ (car openings)) (pop openings)))
   1597 		(_ (when (eq ?\( (car openings)) (pop openings)))))
   1598 	    (if (null openings)
   1599 		(setq partial
   1600 		      (nconc (nreverse (string-to-list
   1601 					(buffer-substring origin (point))))
   1602 			     partial))
   1603 	      ;; Un-balanced bracket.  Backtrack.
   1604 	      (push after partial)
   1605 	      (goto-char (1+ origin)))))
   1606 	 ((and (eq ?\" (char-after)) (not (eq ?\\ (char-before))))
   1607 	  ;; Include everything from current double quote to next
   1608 	  ;; non-escaped double quote.
   1609 	  (let ((origin (point)))
   1610 	    (if (re-search-forward "[^\\]\"" nil t)
   1611 		(setq partial
   1612 		      (nconc (nreverse (string-to-list
   1613 					(buffer-substring origin (point))))
   1614 			     partial))
   1615 	      ;; No closing double quote.  Backtrack.
   1616 	      (push ?\" partial)
   1617 	      (forward-char))))
   1618 	 (t (push (char-after) partial)
   1619 	    (forward-char))))
   1620       ;; Add pending parsing and return result.
   1621       (when partial (push (apply #'string (nreverse partial)) result))
   1622       (nreverse result))))
   1623 
   1624 (defun org-babel-join-splits-near-ch (ch list)
   1625   "Join splits where \"=\" is on either end of the split."
   1626   (let ((last= (lambda (str) (= ch (aref str (1- (length str))))))
   1627 	(first= (lambda (str) (= ch (aref str 0)))))
   1628     (reverse
   1629      (cl-reduce (lambda (acc el)
   1630 		  (let ((head (car acc)))
   1631 		    (if (and head (or (funcall last= head) (funcall first= el)))
   1632 			(cons (concat head el) (cdr acc))
   1633 		      (cons el acc))))
   1634 		list :initial-value nil))))
   1635 
   1636 (defun org-babel-parse-header-arguments (string &optional no-eval)
   1637   "Parse header arguments in STRING.
   1638 When optional argument NO-EVAL is non-nil, do not evaluate Lisp
   1639 in parameters.  Return an alist."
   1640   (when (org-string-nw-p string)
   1641     (org-babel-parse-multiple-vars
   1642      (delq nil
   1643 	   (mapcar
   1644 	    (lambda (arg)
   1645 	      (if (string-match
   1646 		   "\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)"
   1647 		   arg)
   1648 		  (cons (intern (match-string 1 arg))
   1649 			(org-babel-read (org-babel-chomp (match-string 2 arg))
   1650 					no-eval))
   1651 		(cons (intern (org-babel-chomp arg)) nil)))
   1652 	    (let ((raw (org-babel-balanced-split string '((32 9) . 58))))
   1653               (cons (car raw)
   1654 		    (mapcar (lambda (r) (concat ":" r)) (cdr raw)))))))))
   1655 
   1656 (defun org-babel-parse-multiple-vars (header-arguments)
   1657   "Expand multiple variable assignments behind a single :var keyword.
   1658 
   1659 This allows expression of multiple variables with one :var as
   1660 shown below.
   1661 
   1662 #+PROPERTY: var foo=1, bar=2"
   1663   (let (results)
   1664     (mapc (lambda (pair)
   1665 	    (if (eq (car pair) :var)
   1666 		(mapcar (lambda (v) (push (cons :var (org-trim v)) results))
   1667 			(org-babel-join-splits-near-ch
   1668 			 61 (org-babel-balanced-split (cdr pair) 32)))
   1669 	      (push pair results)))
   1670 	  header-arguments)
   1671     (nreverse results)))
   1672 
   1673 (defun org-babel-process-params (params)
   1674   "Expand variables in PARAMS and add summary parameters."
   1675   (let* ((processed-vars (mapcar (lambda (el)
   1676 				   (if (consp el)
   1677 				       el
   1678 				     (org-babel-ref-parse el)))
   1679 				 (org-babel--get-vars params)))
   1680 	 (vars-and-names (if (and (assq :colname-names params)
   1681 				  (assq :rowname-names params))
   1682 			     (list processed-vars)
   1683 			   (org-babel-disassemble-tables
   1684 			    processed-vars
   1685 			    (cdr (assq :hlines params))
   1686 			    (cdr (assq :colnames params))
   1687 			    (cdr (assq :rownames params)))))
   1688 	 (raw-result (or (cdr (assq :results params)) ""))
   1689 	 (result-params (delete-dups
   1690 			 (append
   1691 			  (split-string (if (stringp raw-result)
   1692 					    raw-result
   1693                                           ;; FIXME: Arbitrary code evaluation.
   1694 					  (eval raw-result t)))
   1695 			  (cdr (assq :result-params params))))))
   1696     (append
   1697      (mapcar (lambda (var) (cons :var var)) (car vars-and-names))
   1698      (list
   1699       (cons :colname-names (or (cdr (assq :colname-names params))
   1700 			       (cadr  vars-and-names)))
   1701       (cons :rowname-names (or (cdr (assq :rowname-names params))
   1702 			       (cl-caddr vars-and-names)))
   1703       (cons :result-params result-params)
   1704       (cons :result-type  (cond ((member "output" result-params) 'output)
   1705 				((member "value" result-params) 'value)
   1706 				(t 'value))))
   1707      (cl-remove-if
   1708       (lambda (x) (memq (car x) '(:colname-names :rowname-names :result-params
   1709 					         :result-type :var)))
   1710       params))))
   1711 
   1712 ;; row and column names
   1713 (defun org-babel-del-hlines (table)
   1714   "Remove all `hline's from TABLE."
   1715   (remq 'hline table))
   1716 
   1717 (defun org-babel-get-colnames (table)
   1718   "Return the column names of TABLE.
   1719 Return a cons cell, the `car' of which contains the TABLE less
   1720 colnames, and the `cdr' of which contains a list of the column
   1721 names."
   1722   (if (eq 'hline (nth 1 table))
   1723       (cons (cddr table) (car table))
   1724     (cons (cdr table) (car table))))
   1725 
   1726 (defun org-babel-get-rownames (table)
   1727   "Return the row names of TABLE.
   1728 Return a cons cell, the `car' of which contains the TABLE less
   1729 rownames, and the `cdr' of which contains a list of the rownames.
   1730 Note: this function removes any hlines in TABLE."
   1731   (let* ((table (org-babel-del-hlines table))
   1732 	 (rownames (funcall (lambda ()
   1733 			      (let ((tp table))
   1734 				(mapcar
   1735 				 (lambda (_row)
   1736 				   (prog1
   1737 				       (pop (car tp))
   1738 				     (setq tp (cdr tp))))
   1739 				 table))))))
   1740     (cons table rownames)))
   1741 
   1742 (defun org-babel-put-colnames (table colnames)
   1743   "Add COLNAMES to TABLE if they exist."
   1744   (if colnames (apply 'list colnames 'hline table) table))
   1745 
   1746 (defun org-babel-put-rownames (table rownames)
   1747   "Add ROWNAMES to TABLE if they exist."
   1748   (if rownames
   1749       (mapcar (lambda (row)
   1750                 (if (listp row)
   1751                     (cons (or (pop rownames) "") row)
   1752                   row))
   1753 	      table)
   1754     table))
   1755 
   1756 (defun org-babel-pick-name (names selector)
   1757   "Select one out of an alist of row or column names.
   1758 SELECTOR can be either a list of names in which case those names
   1759 will be returned directly, or an index into the list NAMES in
   1760 which case the indexed names will be return."
   1761   (if (listp selector)
   1762       selector
   1763     (when names
   1764       (if (and selector (symbolp selector) (not (equal t selector)))
   1765 	  (cdr (assoc selector names))
   1766 	(if (integerp selector)
   1767 	    (nth (- selector 1) names)
   1768 	  (cdr (car (last names))))))))
   1769 
   1770 (defun org-babel-disassemble-tables (vars hlines colnames rownames)
   1771   "Parse tables for further processing.
   1772 Process the variables in VARS according to the HLINES,
   1773 ROWNAMES and COLNAMES header arguments.  Return a list consisting
   1774 of the vars, cnames and rnames."
   1775   (let (cnames rnames)
   1776     (list
   1777      (mapcar
   1778       (lambda (var)
   1779         (when (proper-list-p (cdr var))
   1780           (when (and (not (equal colnames "no"))
   1781                      ;; Compatibility note: avoid `length>', which
   1782                      ;; isn't available until Emacs 28.
   1783                      (or colnames (and (> (length (cdr var)) 1)
   1784                                        (eq (nth 1 (cdr var)) 'hline)
   1785                                        (not (member 'hline (cddr (cdr var)))))))
   1786             (let ((both (org-babel-get-colnames (cdr var))))
   1787               (setq cnames (cons (cons (car var) (cdr both))
   1788                                  cnames))
   1789               (setq var (cons (car var) (car both)))))
   1790           (when (and rownames (not (equal rownames "no")))
   1791             (let ((both (org-babel-get-rownames (cdr var))))
   1792               (setq rnames (cons (cons (car var) (cdr both))
   1793                                  rnames))
   1794               (setq var (cons (car var) (car both)))))
   1795           (when (and hlines (not (equal hlines "yes")))
   1796             (setq var (cons (car var) (org-babel-del-hlines (cdr var))))))
   1797         var)
   1798       vars)
   1799      (reverse cnames) (reverse rnames))))
   1800 
   1801 (defun org-babel-reassemble-table (table colnames rownames)
   1802   "Add column and row names to a table.
   1803 Given a TABLE and set of COLNAMES and ROWNAMES add the names
   1804 to the table for reinsertion to `org-mode'."
   1805   (if (listp table)
   1806       (let ((table (if (and rownames (= (length table) (length rownames)))
   1807                        (org-babel-put-rownames table rownames) table)))
   1808         (if (and colnames (listp (car table)) (= (length (car table))
   1809                                                  (length colnames)))
   1810             (org-babel-put-colnames table colnames) table))
   1811     table))
   1812 
   1813 (defun org-babel-where-is-src-block-head (&optional src-block)
   1814   "Find where the current source block begins.
   1815 
   1816 If optional argument SRC-BLOCK is `src-block' type element, find
   1817 its current beginning instead.
   1818 
   1819 Return the point at the beginning of the current source block.
   1820 Specifically at the beginning of the #+BEGIN_SRC line.  Also set
   1821 match-data relatively to `org-babel-src-block-regexp', which see.
   1822 If the point is not on a source block or within blank lines after an
   1823 src block, then return nil."
   1824   (let ((element (or src-block (org-element-at-point))))
   1825     (when (eq (org-element-type element) 'src-block)
   1826       (let ((end (org-element-property :end element)))
   1827 	(org-with-wide-buffer
   1828 	 ;; Ensure point is not on a blank line after the block.
   1829 	 (beginning-of-line)
   1830 	 (skip-chars-forward " \r\t\n" end)
   1831 	 (when (< (point) end)
   1832 	   (prog1 (goto-char (org-element-property :post-affiliated element))
   1833 	     (looking-at org-babel-src-block-regexp))))))))
   1834 
   1835 ;;;###autoload
   1836 (defun org-babel-goto-src-block-head ()
   1837   "Go to the beginning of the current code block."
   1838   (interactive)
   1839   (let ((head (org-babel-where-is-src-block-head)))
   1840     (if head (goto-char head) (error "Not currently in a code block"))))
   1841 
   1842 ;;;###autoload
   1843 (defun org-babel-goto-named-src-block (name)
   1844   "Go to a named source-code block."
   1845   (interactive
   1846    (let ((completion-ignore-case t)
   1847 	 (case-fold-search t)
   1848 	 (all-block-names (org-babel-src-block-names)))
   1849      (list (completing-read
   1850 	    "source-block name: " all-block-names nil t
   1851 	    (let* ((context (org-element-context))
   1852 		   (type (org-element-type context))
   1853 		   (noweb-ref
   1854 		    (and (memq type '(inline-src-block src-block))
   1855 			 (org-in-regexp (org-babel-noweb-wrap)))))
   1856 	      (cond
   1857 	       (noweb-ref
   1858 		(buffer-substring
   1859 		 (+ (car noweb-ref) (length org-babel-noweb-wrap-start))
   1860 		 (- (cdr noweb-ref) (length org-babel-noweb-wrap-end))))
   1861 	       ((memq type '(babel-call inline-babel-call)) ;#+CALL:
   1862 		(org-element-property :call context))
   1863 	       ((car (org-element-property :results context))) ;#+RESULTS:
   1864 	       ((let ((symbol (thing-at-point 'symbol))) ;Symbol.
   1865 		  (and symbol
   1866 		       (member-ignore-case symbol all-block-names)
   1867 		       symbol)))
   1868 	       (t "")))))))
   1869   (let ((point (org-babel-find-named-block name)))
   1870     (if point
   1871         ;; Taken from `org-open-at-point'.
   1872         (progn (org-mark-ring-push) (goto-char point) (org-fold-show-context))
   1873       (message "source-code block `%s' not found in this buffer" name))))
   1874 
   1875 (defun org-babel-find-named-block (name)
   1876   "Find a named source-code block.
   1877 Return the location of the source block identified by source
   1878 NAME, or nil if no such block exists.  Set match data according
   1879 to `org-babel-named-src-block-regexp'."
   1880   (save-excursion
   1881     (goto-char (point-min))
   1882     (let ((regexp (org-babel-named-src-block-regexp-for-name name)))
   1883       (or (and (looking-at regexp)
   1884 	       (progn (goto-char (match-beginning 1))
   1885 		      (line-beginning-position)))
   1886 	  (ignore-errors (org-next-block 1 nil regexp))))))
   1887 
   1888 (defun org-babel-src-block-names (&optional file)
   1889   "Return the names of source blocks in FILE or the current buffer."
   1890   (with-current-buffer (if file (find-file-noselect file) (current-buffer))
   1891     (org-with-point-at 1
   1892       (let ((regexp "^[ \t]*#\\+begin_src ")
   1893 	    (case-fold-search t)
   1894 	    (names nil))
   1895 	(while (re-search-forward regexp nil t)
   1896 	  (let ((element (org-element-at-point)))
   1897 	    (when (eq 'src-block (org-element-type element))
   1898 	      (let ((name (org-element-property :name element)))
   1899 		(when name (push name names))))))
   1900 	names))))
   1901 
   1902 ;;;###autoload
   1903 (defun org-babel-goto-named-result (name)
   1904   "Go to a named result."
   1905   (interactive
   1906    (let ((completion-ignore-case t))
   1907      (list (completing-read "Source-block name: "
   1908 			    (org-babel-result-names) nil t))))
   1909   (let ((point (org-babel-find-named-result name)))
   1910     (if point
   1911         ;; taken from `org-open-at-point'
   1912         (progn (goto-char point) (org-fold-show-context))
   1913       (message "result `%s' not found in this buffer" name))))
   1914 
   1915 (defun org-babel-find-named-result (name)
   1916   "Find a named result.
   1917 Return the location of the result named NAME in the current
   1918 buffer or nil if no such result exists."
   1919   (save-excursion
   1920     (goto-char (point-min))
   1921     (let ((case-fold-search t)
   1922 	  (re (format "^[ \t]*#\\+%s.*?:[ \t]*%s[ \t]*$"
   1923 		      org-babel-results-keyword
   1924 		      (regexp-quote name))))
   1925       (catch :found
   1926 	(while (re-search-forward re nil t)
   1927 	  (let ((element (org-element-at-point)))
   1928 	    (when (or (eq (org-element-type element) 'keyword)
   1929 		      (< (point)
   1930 			 (org-element-property :post-affiliated element)))
   1931 	      (throw :found (line-beginning-position)))))))))
   1932 
   1933 (defun org-babel-result-names (&optional file)
   1934   "Return the names of results in FILE or the current buffer."
   1935   (save-excursion
   1936     (when file (find-file file)) (goto-char (point-min))
   1937     (let ((case-fold-search t) names)
   1938       (while (re-search-forward org-babel-result-w-name-regexp nil t)
   1939 	(setq names (cons (match-string-no-properties 9) names)))
   1940       names)))
   1941 
   1942 ;;;###autoload
   1943 (defun org-babel-next-src-block (&optional arg)
   1944   "Jump to the next source block.
   1945 With optional prefix argument ARG, jump forward ARG many source blocks."
   1946   (interactive "p")
   1947   (org-next-block arg nil org-babel-src-block-regexp))
   1948 
   1949 ;;;###autoload
   1950 (defun org-babel-previous-src-block (&optional arg)
   1951   "Jump to the previous source block.
   1952 With optional prefix argument ARG, jump backward ARG many source blocks."
   1953   (interactive "p")
   1954   (org-previous-block arg org-babel-src-block-regexp))
   1955 
   1956 (defvar org-babel-load-languages)
   1957 
   1958 ;;;###autoload
   1959 (defun org-babel-mark-block ()
   1960   "Mark current source block."
   1961   (interactive)
   1962   (let ((head (org-babel-where-is-src-block-head)))
   1963     (when head
   1964       (save-excursion
   1965         (goto-char head)
   1966         (looking-at org-babel-src-block-regexp))
   1967       (push-mark (match-end 5) nil t)
   1968       (goto-char (match-beginning 5)))))
   1969 
   1970 (defun org-babel-demarcate-block (&optional arg)
   1971   "Wrap or split the code in the region or on the point.
   1972 When called from inside of a code block the current block is
   1973 split.  When called from outside of a code block a new code block
   1974 is created.  In both cases if the region is demarcated and if the
   1975 region is not active then the point is demarcated.
   1976 
   1977 When called within blank lines after a code block, create a new code
   1978 block of the same language with the previous."
   1979   (interactive "P")
   1980   (let* ((info (org-babel-get-src-block-info 'no-eval))
   1981 	 (start (org-babel-where-is-src-block-head))
   1982          ;; `start' will be nil when within space lines after src block.
   1983 	 (block (and start (match-string 0)))
   1984 	 (headers (and start (match-string 4)))
   1985 	 (stars (concat (make-string (or (org-current-level) 1) ?*) " "))
   1986 	 (upper-case-p (and block
   1987 			    (let (case-fold-search)
   1988 			      (string-match-p "#\\+BEGIN_SRC" block)))))
   1989     (if (and info start) ;; At src block, but not within blank lines after it.
   1990         (mapc
   1991          (lambda (place)
   1992            (save-excursion
   1993              (goto-char place)
   1994              (let ((lang (nth 0 info))
   1995                    (indent (make-string (org-current-text-indentation) ?\s)))
   1996 	       (when (string-match "^[[:space:]]*$"
   1997                                    (buffer-substring (line-beginning-position)
   1998                                                      (line-end-position)))
   1999                  (delete-region (line-beginning-position) (line-end-position)))
   2000                (insert (concat
   2001 		        (if (looking-at "^") "" "\n")
   2002 		        indent (if upper-case-p "#+END_SRC\n" "#+end_src\n")
   2003 		        (if arg stars indent) "\n"
   2004 		        indent (if upper-case-p "#+BEGIN_SRC " "#+begin_src ")
   2005 		        lang
   2006 		        (if (> (length headers) 1)
   2007 			    (concat " " headers) headers)
   2008 		        (if (looking-at "[\n\r]")
   2009 			    ""
   2010 			  (concat "\n" (make-string (current-column) ? )))))))
   2011 	   (move-end-of-line 2))
   2012          (sort (if (org-region-active-p) (list (mark) (point)) (list (point))) #'>))
   2013       (let ((start (point))
   2014 	    (lang (or (car info) ; Reuse language from previous block.
   2015                       (completing-read
   2016 		       "Lang: "
   2017 		       (mapcar #'symbol-name
   2018 			       (delete-dups
   2019 			        (append (mapcar #'car org-babel-load-languages)
   2020 				        (mapcar (lambda (el) (intern (car el)))
   2021 					        org-src-lang-modes)))))))
   2022 	    (body (delete-and-extract-region
   2023 		   (if (org-region-active-p) (mark) (point)) (point))))
   2024 	(insert (concat (if (looking-at "^") "" "\n")
   2025 			(if arg (concat stars "\n") "")
   2026 			(if upper-case-p "#+BEGIN_SRC " "#+begin_src ")
   2027 			lang "\n" body
   2028 			(if (or (= (length body) 0)
   2029 				(string-suffix-p "\r" body)
   2030 				(string-suffix-p "\n" body))
   2031 			    ""
   2032 			  "\n")
   2033 			(if upper-case-p "#+END_SRC\n" "#+end_src\n")))
   2034 	(goto-char start)
   2035 	(move-end-of-line 1)))))
   2036 
   2037 (defun org-babel--insert-results-keyword (name hash)
   2038   "Insert RESULTS keyword with NAME value at point.
   2039 If NAME is nil, results are anonymous.  HASH is a string used as
   2040 the results hash, or nil.  Leave point before the keyword."
   2041   (save-excursion (insert "\n"))	;open line to indent.
   2042   (org-indent-line)
   2043   (delete-char 1)
   2044   (insert (concat "#+" org-babel-results-keyword
   2045 		  (cond ((not hash) nil)
   2046 			(org-babel-hash-show-time
   2047 			 (format "[%s %s]"
   2048 				 (format-time-string "(%F %T)")
   2049 				 hash))
   2050 			(t (format "[%s]" hash)))
   2051 		  ":"
   2052 		  (when name (concat " " name))
   2053 		  "\n"))
   2054   ;; Make sure results are going to be followed by at least one blank
   2055   ;; line so they do not get merged with the next element, e.g.,
   2056   ;;
   2057   ;;   #+results:
   2058   ;;   : 1
   2059   ;;
   2060   ;;   : fixed-width area, unrelated to the above.
   2061   (unless (looking-at "^[ \t]*$") (save-excursion (insert "\n")))
   2062   (beginning-of-line 0)
   2063   (when hash (org-babel-hide-hash)))
   2064 
   2065 (defun org-babel--clear-results-maybe (hash)
   2066   "Clear results when hash doesn't match HASH.
   2067 
   2068 When results hash does not match HASH, remove RESULTS keyword at
   2069 point, along with related contents.  Do nothing if HASH is nil.
   2070 
   2071 Return a non-nil value if results were cleared.  In this case,
   2072 leave point where new results should be inserted."
   2073   (when hash
   2074     (let ((case-fold-search t)) (looking-at org-babel-result-regexp))
   2075     (unless (string= (match-string 1) hash)
   2076       (let* ((e (org-element-at-point))
   2077 	     (post (copy-marker (org-element-property :post-affiliated e))))
   2078 	;; Delete contents.
   2079 	(delete-region post
   2080 		       (save-excursion
   2081 			 (goto-char (org-element-property :end e))
   2082 			 (skip-chars-backward " \t\n")
   2083 			 (line-beginning-position 2)))
   2084 	;; Delete RESULT keyword.  However, if RESULTS keyword is
   2085 	;; orphaned, ignore this part.  The deletion above already
   2086 	;; took care of it.
   2087 	(unless (= (point) post)
   2088 	  (delete-region (line-beginning-position)
   2089 			 (line-beginning-position 2)))
   2090 	(goto-char post)
   2091 	(set-marker post nil)
   2092 	t))))
   2093 
   2094 (defun org-babel-where-is-src-block-result (&optional insert _info hash)
   2095   "Find where the current source block results begin.
   2096 
   2097 Return the point at the beginning of the result of the current
   2098 source block, specifically at the beginning of the results line.
   2099 
   2100 If no result exists for this block return nil, unless optional
   2101 argument INSERT is non-nil.  In this case, create a results line
   2102 following the source block and return the position at its
   2103 beginning.  In the case of inline code, remove the results part
   2104 instead.
   2105 
   2106 If optional argument HASH is a string, remove contents related to
   2107 RESULTS keyword if its hash is different.  Then update the latter
   2108 to HASH."
   2109   (let ((context (org-element-context)))
   2110     (catch :found
   2111       (org-with-wide-buffer
   2112        (pcase (org-element-type context)
   2113 	 ((or `inline-babel-call `inline-src-block)
   2114 	  ;; Results for inline objects are located right after them.
   2115 	  ;; There is no RESULTS line to insert either.
   2116 	  (let ((limit (pcase (org-element-type (org-element-property :parent context))
   2117                          (`section (org-element-property
   2118 		                    :end (org-element-property :parent context)))
   2119                          (_ (org-element-property
   2120 		             :contents-end (org-element-property :parent context))))))
   2121 	    (goto-char (org-element-property :end context))
   2122 	    (skip-chars-forward " \t\n" limit)
   2123 	    (throw :found
   2124 		   (and
   2125 		    (< (point) limit)
   2126 		    (let ((result (org-element-context)))
   2127 		      (and (eq (org-element-type result) 'macro)
   2128 			   (string= (org-element-property :key result)
   2129 				    "results")
   2130 			   (if (not insert) (point)
   2131 			     (delete-region
   2132 			      (point)
   2133 			      (progn
   2134 				(goto-char (org-element-property :end result))
   2135 				(skip-chars-backward " \t")
   2136 				(point)))
   2137 			     (point))))))))
   2138 	 ((or `babel-call `src-block)
   2139 	  (let* ((name (org-element-property :name context))
   2140 		 (named-results (and name (org-babel-find-named-result name))))
   2141 	    (goto-char (or named-results (org-element-property :end context)))
   2142 	    (cond
   2143 	     ;; Existing results named after the current source.
   2144 	     (named-results
   2145 	      (when (org-babel--clear-results-maybe hash)
   2146 		(org-babel--insert-results-keyword name hash))
   2147 	      (throw :found (point)))
   2148 	     ;; Named results expect but none to be found.
   2149 	     (name)
   2150 	     ;; No possible anonymous results at the very end of
   2151 	     ;; buffer or outside CONTEXT parent.
   2152 	     ((eq (point)
   2153 		  (or (pcase (org-element-type (org-element-property :parent context))
   2154                         ((or `section `org-data) (org-element-property
   2155 		                                  :end (org-element-property :parent context)))
   2156                         (_ (org-element-property
   2157 		            :contents-end (org-element-property :parent context))))
   2158 		      (point-max))))
   2159 	     ;; Check if next element is an anonymous result below
   2160 	     ;; the current block.
   2161 	     ((let* ((next (org-element-at-point))
   2162 		     (end (save-excursion
   2163 			    (goto-char
   2164 			     (org-element-property :post-affiliated next))
   2165 			    (line-end-position)))
   2166 		     (empty-result-re (concat org-babel-result-regexp "$"))
   2167 		     (case-fold-search t))
   2168 		(re-search-forward empty-result-re end t))
   2169 	      (beginning-of-line)
   2170 	      (when (org-babel--clear-results-maybe hash)
   2171 		(org-babel--insert-results-keyword nil hash))
   2172 	      (throw :found (point))))))
   2173 	 ;; Ignore other elements.
   2174 	 (_ (throw :found nil))))
   2175       ;; No result found.  Insert a RESULTS keyword below element, if
   2176       ;; appropriate.  In this case, ensure there is an empty line
   2177       ;; after the previous element.
   2178       (when insert
   2179 	(save-excursion
   2180 	  (goto-char (min (org-element-property :end context) (point-max)))
   2181 	  (skip-chars-backward " \t\n")
   2182 	  (forward-line)
   2183 	  (unless (bolp) (insert "\n"))
   2184 	  (insert "\n")
   2185 	  (org-babel--insert-results-keyword
   2186 	   (org-element-property :name context) hash)
   2187 	  (point))))))
   2188 
   2189 (defun org-babel-read-element (element)
   2190   "Read ELEMENT into emacs-lisp.
   2191 Return nil if ELEMENT cannot be read."
   2192   (org-with-wide-buffer
   2193    (goto-char (org-element-property :post-affiliated element))
   2194    (pcase (org-element-type element)
   2195      (`fixed-width
   2196       (let ((v (org-trim (org-element-property :value element))))
   2197 	(or (org-babel--string-to-number v) v)))
   2198      (`table (org-babel-read-table))
   2199      (`plain-list (org-babel-read-list))
   2200      ((or `example-block `src-block)
   2201       (let ((v (org-element-property :value element)))
   2202 	(if (or org-src-preserve-indentation
   2203 		(org-element-property :preserve-indent element))
   2204 	    v
   2205 	  (org-remove-indentation v))))
   2206      (`export-block
   2207       (org-remove-indentation (org-element-property :value element)))
   2208      (`paragraph
   2209       ;; Treat paragraphs containing a single link specially.
   2210       (skip-chars-forward " \t")
   2211       (if (and (looking-at org-link-bracket-re)
   2212 	       (save-excursion
   2213 		 (goto-char (match-end 0))
   2214 		 (skip-chars-forward " \r\t\n")
   2215 		 (<= (org-element-property :end element)
   2216 		     (point))))
   2217 	  (org-babel-read-link)
   2218 	(buffer-substring-no-properties
   2219 	 (org-element-property :contents-begin element)
   2220 	 (org-element-property :contents-end element))))
   2221      ((or `center-block `quote-block `verse-block `special-block)
   2222       (org-remove-indentation
   2223        (buffer-substring-no-properties
   2224 	(org-element-property :contents-begin element)
   2225 	(org-element-property :contents-end element))))
   2226      (_ nil))))
   2227 
   2228 (defun org-babel-read-result ()
   2229   "Read the result at point into emacs-lisp."
   2230   (and (not (save-excursion
   2231 	      (beginning-of-line)
   2232 	      (looking-at-p "[ \t]*$")))
   2233        (org-babel-read-element (org-element-at-point))))
   2234 
   2235 (defun org-babel-read-table ()
   2236   "Read the table at point into emacs-lisp."
   2237   (mapcar (lambda (row)
   2238             (if (and (symbolp row) (equal row 'hline)) row
   2239               (mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval)) row)))
   2240           (org-table-to-lisp)))
   2241 
   2242 (defun org-babel-read-list ()
   2243   "Read the list at point into emacs-lisp.
   2244 
   2245 Return the list of strings representing top level items:
   2246 
   2247    (item1 item2 ...)
   2248 
   2249 Only consider top level items.  See Info node
   2250 `(org)Environment of a Code Block'."
   2251   (mapcar (lambda (el) (org-babel-read (car el) 'inhibit-lisp-eval))
   2252 	  (cdr (org-list-to-lisp))))
   2253 
   2254 (defvar org-link-types-re)
   2255 (defun org-babel-read-link ()
   2256   "Read the link at point into emacs-lisp.
   2257 If the path of the link is a file path it is expanded using
   2258 `expand-file-name'."
   2259   (let* ((case-fold-search t)
   2260          (raw (and (looking-at org-link-bracket-re)
   2261                    (org-no-properties (match-string 1))))
   2262          (type (and (string-match org-link-types-re raw)
   2263                     (match-string 1 raw))))
   2264     (cond
   2265      ((not type) (expand-file-name raw))
   2266      ((string= type "file")
   2267       (and (string-match "file\\(.*\\):\\(.+\\)" raw)
   2268            (expand-file-name (match-string 2 raw))))
   2269      (t raw))))
   2270 
   2271 (defun org-babel-format-result (result &optional sep)
   2272   "Format RESULT for writing to file."
   2273   (let ((echo-res (lambda (r) (if (stringp r) r (format "%S" r)))))
   2274     (if (listp result)
   2275 	;; table result
   2276 	(orgtbl-to-generic
   2277 	 result (list :sep (or sep "\t") :fmt echo-res))
   2278       ;; scalar result
   2279       (funcall echo-res result))))
   2280 
   2281 (defun org-babel-insert-result (result &optional result-params info hash lang exec-time)
   2282   "Insert RESULT into the current buffer.
   2283 
   2284 By default RESULT is inserted after the end of the current source
   2285 block.  The RESULT of an inline source block usually will be
   2286 wrapped inside a `results' macro and placed on the same line as
   2287 the inline source block.  The macro is stripped upon export.
   2288 Multiline and non-scalar RESULTS from inline source blocks are
   2289 not allowed.  When EXEC-TIME is provided it may be included in a
   2290 generated message.  With optional argument RESULT-PARAMS controls
   2291 insertion of results in the Org mode file.  RESULT-PARAMS can
   2292 take the following values:
   2293 
   2294 replace - (default option) insert results after the source block
   2295           or inline source block replacing any previously
   2296           inserted results.
   2297 
   2298 silent -- no results are inserted into the Org buffer but
   2299           the results are echoed to the minibuffer and are
   2300           ingested by Emacs (a potentially time consuming
   2301           process).
   2302 
   2303 none ---- no results are inserted into the Org buffer nor
   2304           echoed to the minibuffer. they are not processed into
   2305           Emacs-lisp objects at all.
   2306 
   2307 file ---- the results are interpreted as a file path, and are
   2308           inserted into the buffer using the Org file syntax.
   2309 
   2310 list ---- the results are interpreted as an Org list.
   2311 
   2312 raw ----- results are added directly to the Org file.  This is
   2313           a good option if you code block will output Org
   2314           formatted text.
   2315 
   2316 drawer -- results are added directly to the Org file as with
   2317           \"raw\", but are wrapped in a RESULTS drawer or results
   2318           macro, allowing them to later be replaced or removed
   2319           automatically.
   2320 
   2321 org ----- results are added inside of a \"src_org{}\" or \"#+BEGIN_SRC
   2322           org\" block depending on whether the current source block is
   2323           inline or not.  They are not comma-escaped when inserted,
   2324           but Org syntax here will be discarded when exporting the
   2325           file.
   2326 
   2327 html ---- results are added inside of a #+BEGIN_EXPORT HTML block
   2328           or html export snippet depending on whether the current
   2329           source block is inline or not.  This is a good option
   2330           if your code block will output html formatted text.
   2331 
   2332 latex --- results are added inside of a #+BEGIN_EXPORT LATEX
   2333           block or latex export snippet depending on whether the
   2334           current source block is inline or not.  This is a good
   2335           option if your code block will output latex formatted
   2336           text.
   2337 
   2338 code ---- the results are extracted in the syntax of the source
   2339           code of the language being evaluated and are added
   2340           inside of a source block with the source-code language
   2341           set appropriately.  Also, source block inlining is
   2342           preserved in this case.  Note this relies on the
   2343           optional LANG argument.
   2344 
   2345 list ---- the results are rendered as a list.  This option not
   2346           allowed for inline source blocks.
   2347 
   2348 table --- the results are rendered as a table.  This option not
   2349           allowed for inline source blocks.
   2350 
   2351 INFO may provide the values of these header arguments (in the
   2352 `header-arguments-alist' see the docstring for
   2353 `org-babel-get-src-block-info'):
   2354 
   2355 :file --- the name of the file to which output should be written.
   2356 
   2357 :wrap --- the effect is similar to `latex' in RESULT-PARAMS but
   2358           using the argument supplied to specify the export block
   2359           or snippet type."
   2360   (cond ((stringp result)
   2361 	 (setq result (org-no-properties result))
   2362 	 (when (member "file" result-params)
   2363 	   (setq result
   2364                  (org-babel-result-to-file
   2365 		  result
   2366 		  (org-babel--file-desc (nth 2 info) result)
   2367                   'attachment))))
   2368 	((listp result))
   2369 	(t (setq result (format "%S" result))))
   2370 
   2371   (if (and result-params (member "silent" result-params))
   2372       (progn (message (replace-regexp-in-string "%" "%%" (format "%S" result)))
   2373 	     result)
   2374     (let ((inline (let ((context (org-element-context)))
   2375 		    (and (memq (org-element-type context)
   2376 			       '(inline-babel-call inline-src-block))
   2377 			 context))))
   2378       (when inline
   2379 	(let ((warning
   2380 	       (or (and (member "table" result-params) "`:results table'")
   2381 		   (and result (listp result) "list result")
   2382 		   (and result (string-match-p "\n." result) "multiline result")
   2383 		   (and (member "list" result-params) "`:results list'"))))
   2384 	  (when warning
   2385 	    (user-error "Inline error: %s cannot be used" warning))))
   2386       (save-excursion
   2387 	(let* ((visible-beg (point-min-marker))
   2388 	       (visible-end (copy-marker (point-max) t))
   2389 	       (inline (let ((context (org-element-context)))
   2390 			 (and (memq (org-element-type context)
   2391 				    '(inline-babel-call inline-src-block))
   2392 			      context)))
   2393 	       (existing-result (org-babel-where-is-src-block-result t nil hash))
   2394 	       (results-switches (cdr (assq :results_switches (nth 2 info))))
   2395 	       ;; When results exist outside of the current visible
   2396 	       ;; region of the buffer, be sure to widen buffer to
   2397 	       ;; update them.
   2398 	       (outside-scope (and existing-result
   2399 				   (buffer-narrowed-p)
   2400 				   (or (> visible-beg existing-result)
   2401 				       (<= visible-end existing-result))))
   2402 	       beg end indent)
   2403 	  ;; Ensure non-inline results end in a newline.
   2404 	  (when (and (org-string-nw-p result)
   2405 		     (not inline)
   2406 		     (not (string-equal (substring result -1) "\n")))
   2407 	    (setq result (concat result "\n")))
   2408 	  (unwind-protect
   2409 	      (progn
   2410 		(when outside-scope (widen))
   2411 		(if existing-result (goto-char existing-result)
   2412 		  (goto-char (org-element-property :end inline))
   2413 		  (skip-chars-backward " \t"))
   2414 		(unless inline
   2415 		  (setq indent (current-indentation))
   2416 		  (forward-line 1))
   2417 		(setq beg (point))
   2418 		(cond
   2419 		 (inline
   2420 		   ;; Make sure new results are separated from the
   2421 		   ;; source code by one space.
   2422 		   (unless existing-result
   2423 		     (insert " ")
   2424 		     (setq beg (point))))
   2425 		 ((member "replace" result-params)
   2426 		  (delete-region (point) (org-babel-result-end)))
   2427 		 ((member "append" result-params)
   2428 		  (goto-char (org-babel-result-end)) (setq beg (point-marker)))
   2429 		 ((member "prepend" result-params))) ; already there
   2430 		(setq results-switches
   2431 		      (if results-switches (concat " " results-switches) ""))
   2432 		(let ((wrap
   2433 		       (lambda (start finish &optional no-escape no-newlines
   2434 				      inline-start inline-finish)
   2435 			 (when inline
   2436 			   (setq start inline-start)
   2437 			   (setq finish inline-finish)
   2438 			   (setq no-newlines t))
   2439 			 (let ((before-finish (copy-marker end)))
   2440 			   (goto-char end)
   2441 			   (insert (concat finish (unless no-newlines "\n")))
   2442 			   (goto-char beg)
   2443 			   (insert (concat start (unless no-newlines "\n")))
   2444 			   (unless no-escape
   2445 			     (org-escape-code-in-region
   2446 			      (min (point) before-finish) before-finish))
   2447 			   (goto-char end))))
   2448 		      (tabulablep
   2449 		       (lambda (r)
   2450 			 ;; Non-nil when result R can be turned into
   2451 			 ;; a table.
   2452                          (and (proper-list-p r)
   2453 			      (cl-every
   2454                                (lambda (e) (or (atom e) (proper-list-p e)))
   2455 			       result)))))
   2456 		  ;; insert results based on type
   2457 		  (cond
   2458 		   ;; Do nothing for an empty result.
   2459 		   ((null result))
   2460 		   ;; Insert a list if preferred.
   2461 		   ((member "list" result-params)
   2462 		    (insert
   2463 		     (org-trim
   2464 		      (org-list-to-org
   2465                        ;; We arbitrarily choose to format non-strings
   2466                        ;; as %S.
   2467 		       (cons 'unordered
   2468 			     (mapcar
   2469 			      (lambda (e)
   2470                                 (cond
   2471                                  ((stringp e) (list e))
   2472                                  ((listp e)
   2473                                   (mapcar
   2474                                    (lambda (x)
   2475                                      (if (stringp x) x (format "%S" x)))
   2476                                    e))
   2477                                  (t (list (format "%S" e)))))
   2478 			      (if (listp result) result
   2479 				(split-string result "\n" t))))
   2480 		       '(:splicep nil :istart "- " :iend "\n")))
   2481 		     "\n"))
   2482 		   ;; Try hard to print RESULT as a table.  Give up if
   2483 		   ;; it contains an improper list.
   2484 		   ((funcall tabulablep result)
   2485 		    (goto-char beg)
   2486 		    (insert (concat (orgtbl-to-orgtbl
   2487 				     (if (cl-every
   2488 					  (lambda (e)
   2489 					    (or (eq e 'hline) (listp e)))
   2490 					  result)
   2491 					 result
   2492 				       (list result))
   2493 				     nil)
   2494 				    "\n"))
   2495 		    (goto-char beg)
   2496 		    (when (org-at-table-p) (org-table-align))
   2497 		    (goto-char (org-table-end)))
   2498 		   ;; Print verbatim a list that cannot be turned into
   2499 		   ;; a table.
   2500 		   ((listp result) (insert (format "%s\n" result)))
   2501 		   ((member "file" result-params)
   2502 		    (when inline
   2503 		      (setq result (org-macro-escape-arguments result)))
   2504 		    (insert result))
   2505 		   ((and inline (not (member "raw" result-params)))
   2506 		    (insert (org-macro-escape-arguments
   2507 			     (org-babel-chomp result "\n"))))
   2508 		   (t (goto-char beg) (insert result)))
   2509 		  (setq end (copy-marker (point) t))
   2510 		  ;; Possibly wrap result.
   2511 		  (cond
   2512 		   ((assq :wrap (nth 2 info))
   2513 		    (let* ((full (or (cdr (assq :wrap (nth 2 info))) "results"))
   2514 			   (split (split-string full))
   2515 			   (type (car split))
   2516 			   (opening-line (concat "#+begin_" full))
   2517 			   (closing-line (concat "#+end_" type)))
   2518 		      (cond
   2519 		       ;; Escape contents from "export" wrap.  Wrap
   2520 		       ;; inline results within an export snippet with
   2521 		       ;; appropriate value.
   2522 		       ((org-string-equal-ignore-case type "export")
   2523 			(let ((backend (pcase split
   2524 					 (`(,_) "none")
   2525 					 (`(,_ ,b . ,_) b))))
   2526 			  (funcall wrap
   2527 				   opening-line closing-line
   2528 				   nil nil
   2529 				   (format "{{{results(@@%s:"
   2530 					   backend) "@@)}}}")))
   2531 		       ;; Escape contents from "example" wrap.  Mark
   2532 		       ;; inline results as verbatim.
   2533 		       ((org-string-equal-ignore-case type "example")
   2534 			(funcall wrap
   2535 				 opening-line closing-line
   2536 				 nil nil
   2537 				 "{{{results(=" "=)}}}"))
   2538 		       ;; Escape contents from "src" wrap.  Mark
   2539 		       ;; inline results as inline source code.
   2540 		       ((org-string-equal-ignore-case type "src")
   2541 			(let ((inline-open
   2542 			       (pcase split
   2543 				 (`(,_)
   2544 				  "{{{results(src_none{")
   2545 				 (`(,_ ,language)
   2546 				  (format "{{{results(src_%s{" language))
   2547 				 (`(,_ ,language . ,rest)
   2548 				  (let ((r (mapconcat #'identity rest " ")))
   2549 				    (format "{{{results(src_%s[%s]{"
   2550 					    language r))))))
   2551 			  (funcall wrap
   2552 				   opening-line closing-line
   2553 				   nil nil
   2554 				   inline-open "})}}}")))
   2555 		       ;; Do not escape contents in non-verbatim
   2556 		       ;; blocks.  Return plain inline results.
   2557 		       (t
   2558 			(funcall wrap
   2559 				 opening-line closing-line
   2560 				 t nil
   2561 				 "{{{results(" ")}}}")))))
   2562 		   ((member "html" result-params)
   2563 		    (funcall wrap "#+begin_export html" "#+end_export" nil nil
   2564 			     "{{{results(@@html:" "@@)}}}"))
   2565 		   ((member "latex" result-params)
   2566 		    (funcall wrap "#+begin_export latex" "#+end_export" nil nil
   2567 			     "{{{results(@@latex:" "@@)}}}"))
   2568 		   ((member "org" result-params)
   2569 		    (goto-char beg) (when (org-at-table-p) (org-cycle))
   2570 		    (funcall wrap "#+begin_src org" "#+end_src" nil nil
   2571 			     "{{{results(src_org{" "})}}}"))
   2572 		   ((member "code" result-params)
   2573 		    (let ((lang (or lang "none")))
   2574 		      (funcall wrap (format "#+begin_src %s%s" lang results-switches)
   2575 			       "#+end_src" nil nil
   2576 			       (format "{{{results(src_%s[%s]{" lang results-switches)
   2577 			       "})}}}")))
   2578 		   ((member "raw" result-params)
   2579 		    (goto-char beg) (when (org-at-table-p) (org-cycle)))
   2580 		   ((or (member "drawer" result-params)
   2581 			;; Stay backward compatible with <7.9.2
   2582 			(member "wrap" result-params))
   2583 		    (goto-char beg) (when (org-at-table-p) (org-cycle))
   2584 		    (funcall wrap ":results:" ":end:" 'no-escape nil
   2585 			     "{{{results(" ")}}}"))
   2586 		   ((and inline (member "file" result-params))
   2587 		    (funcall wrap nil nil nil nil "{{{results(" ")}}}"))
   2588 		   ((and (not (funcall tabulablep result))
   2589 			 (not (member "file" result-params)))
   2590 		    (let ((org-babel-inline-result-wrap
   2591 			   ;; Hard code {{{results(...)}}} on top of
   2592 			   ;; customization.
   2593 			   (format "{{{results(%s)}}}"
   2594 				   org-babel-inline-result-wrap)))
   2595 		      (org-babel-examplify-region
   2596 		       beg end results-switches inline)))))
   2597 		;; Possibly indent results in par with #+results line.
   2598 		(when (and (not inline) (numberp indent) (> indent 0)
   2599 			   ;; In this case `table-align' does the work
   2600 			   ;; for us.
   2601 			   (not (and (listp result)
   2602 				     (member "append" result-params))))
   2603 		  (indent-rigidly beg end indent))
   2604                 (let ((time-info
   2605                        ;; Only show the time when something other than
   2606                        ;; 0s will be shown, i.e. check if the time is at
   2607                        ;; least half of the displayed precision.
   2608                        (if (and exec-time (> (float-time exec-time) 0.05))
   2609                            (format " (took %.1fs)" (float-time exec-time))
   2610                          "")))
   2611                   (if (null result)
   2612                       (if (member "value" result-params)
   2613                           (message "Code block returned no value%s." time-info)
   2614                         (message "Code block produced no output%s." time-info))
   2615                     (message "Code block evaluation complete%s." time-info))))
   2616 	    (when end (set-marker end nil))
   2617 	    (when outside-scope (narrow-to-region visible-beg visible-end))
   2618 	    (set-marker visible-beg nil)
   2619 	    (set-marker visible-end nil)))))))
   2620 
   2621 (defun org-babel-remove-result (&optional info keep-keyword)
   2622   "Remove the result of the current source block."
   2623   (interactive)
   2624   (let ((location (org-babel-where-is-src-block-result nil info))
   2625 	(case-fold-search t))
   2626     (when location
   2627       (save-excursion
   2628         (goto-char location)
   2629 	(when (looking-at org-babel-result-regexp)
   2630 	  (delete-region
   2631 	   (if keep-keyword (line-beginning-position 2)
   2632 	     (save-excursion
   2633 	       (skip-chars-backward " \r\t\n")
   2634 	       (line-beginning-position 2)))
   2635 	   (progn (forward-line) (org-babel-result-end))))))))
   2636 
   2637 (defun org-babel-remove-inline-result (&optional datum)
   2638   "Remove the result of the current inline-src-block or babel call.
   2639 The result must be wrapped in a `results' macro to be removed.
   2640 Leading white space is trimmed."
   2641   (interactive)
   2642   (let* ((el (or datum (org-element-context))))
   2643     (when (memq (org-element-type el) '(inline-src-block inline-babel-call))
   2644       (org-with-wide-buffer
   2645        (goto-char (org-element-property :end el))
   2646        (skip-chars-backward " \t")
   2647        (let ((result (save-excursion
   2648 		       (skip-chars-forward
   2649 			" \t\n"
   2650 			(org-element-property
   2651 			 :contents-end (org-element-property :parent el)))
   2652 		       (org-element-context))))
   2653 	 (when (and (eq (org-element-type result) 'macro)
   2654 		    (string= (org-element-property :key result) "results"))
   2655 	   (delete-region		; And leading whitespace.
   2656 	    (point)
   2657 	    (progn (goto-char (org-element-property :end result))
   2658 		   (skip-chars-backward " \t\n")
   2659 		   (point)))))))))
   2660 
   2661 (defun org-babel-remove-result-one-or-many (x)
   2662   "Remove the result of the current source block.
   2663 If called with a prefix argument, remove all result blocks
   2664 in the buffer."
   2665   (interactive "P")
   2666   (if x
   2667       (org-babel-map-src-blocks nil (org-babel-remove-result))
   2668     (org-babel-remove-result)))
   2669 
   2670 (defun org-babel-result-end ()
   2671   "Return the point at the end of the current set of results."
   2672   (cond ((looking-at-p "^[ \t]*$") (point)) ;no result
   2673 	((looking-at-p (format "^[ \t]*%s[ \t]*$" org-link-bracket-re))
   2674 	 (line-beginning-position 2))
   2675 	(t
   2676 	 (let ((element (org-element-at-point)))
   2677 	   (if (memq (org-element-type element)
   2678 		     ;; Possible results types.
   2679                      '(drawer example-block export-block fixed-width
   2680                               special-block src-block item plain-list table
   2681                               latex-environment))
   2682 	       (save-excursion
   2683 		 (goto-char (min (point-max) ;for narrowed buffers
   2684 				 (org-element-property :end element)))
   2685 		 (skip-chars-backward " \r\t\n")
   2686 		 (line-beginning-position 2))
   2687 	     (point))))))
   2688 
   2689 (defun org-babel-result-to-file (result &optional description type)
   2690   "Convert RESULT into an Org link with optional DESCRIPTION.
   2691 If the `default-directory' is different from the containing
   2692 file's directory then expand relative links.
   2693 
   2694 If the optional TYPE is passed as `attachment' and the path is a
   2695 descendant of the DEFAULT-DIRECTORY, the generated link will be
   2696 specified as an an \"attachment:\" style link."
   2697   (when (stringp result)
   2698     (let* ((result-file-name (expand-file-name result))
   2699            (base-file-name (buffer-file-name (buffer-base-buffer)))
   2700            (base-directory (and buffer-file-name
   2701                                 (file-name-directory base-file-name)))
   2702            (same-directory?
   2703 	    (and base-file-name
   2704 	         (not (string= (expand-file-name default-directory)
   2705 			       (expand-file-name
   2706 			        base-directory)))))
   2707            (request-attachment (eq type 'attachment))
   2708            (attach-dir (let* ((default-directory base-directory)
   2709                               (dir (org-attach-dir nil t)))
   2710                          (when dir
   2711                            (expand-file-name dir))))
   2712            (in-attach-dir (and request-attachment
   2713                                attach-dir
   2714                                (string-prefix-p
   2715                                 attach-dir
   2716                                 result-file-name))))
   2717       (format "[[%s:%s]%s]"
   2718               (pcase type
   2719                 ((and 'attachment (guard in-attach-dir)) "attachment")
   2720                 (_ "file"))
   2721               (if (and request-attachment in-attach-dir)
   2722                   (file-relative-name
   2723                    result-file-name
   2724                    (file-name-as-directory attach-dir))
   2725 	        (if (and default-directory
   2726 		         base-file-name same-directory?)
   2727 		    (if (eq org-link-file-path-type 'adaptive)
   2728 		        (file-relative-name
   2729 		         result-file-name
   2730                          (file-name-directory
   2731 			  base-file-name))
   2732 		      result-file-name)
   2733 		  result))
   2734 	      (if description (concat "[" description "]") "")))))
   2735 
   2736 (defun org-babel-examplify-region (beg end &optional results-switches inline)
   2737   "Comment out region using the inline `==' or `: ' org example quote."
   2738   (interactive "*r")
   2739   (let ((maybe-cap
   2740 	 (lambda (str)
   2741 	   (if org-babel-uppercase-example-markers (upcase str) str))))
   2742     (if inline
   2743 	(save-excursion
   2744 	  (goto-char beg)
   2745 	  (insert (format org-babel-inline-result-wrap
   2746 			  (delete-and-extract-region beg end))))
   2747       (let ((size (count-lines beg end)))
   2748 	(save-excursion
   2749 	  (cond ((= size 0))	      ; do nothing for an empty result
   2750 		((< size org-babel-min-lines-for-block-output)
   2751 		 (goto-char beg)
   2752 		 (dotimes (_ size)
   2753 		   (beginning-of-line 1) (insert ": ") (forward-line 1)))
   2754 		(t
   2755 		 (goto-char beg)
   2756 		 (insert (if results-switches
   2757 			     (format "%s%s\n"
   2758 				     (funcall maybe-cap "#+begin_example")
   2759 				     results-switches)
   2760 			   (funcall maybe-cap "#+begin_example\n")))
   2761 		 (let ((p (point)))
   2762 		   (if (markerp end) (goto-char end) (forward-char (- end beg)))
   2763 		   (org-escape-code-in-region p (point)))
   2764 		 (insert (funcall maybe-cap "#+end_example\n")))))))))
   2765 
   2766 (defun org-babel-update-block-body (new-body)
   2767   "Update the body of the current code block to NEW-BODY."
   2768   (let ((element (org-element-at-point)))
   2769     (unless (eq (org-element-type element) 'src-block)
   2770       (error "Not in a source block"))
   2771     (goto-char (org-babel-where-is-src-block-head element))
   2772     (let* ((ind (org-current-text-indentation))
   2773 	   (body-start (line-beginning-position 2))
   2774 	   (body (org-element-normalize-string
   2775 		  (if (or org-src-preserve-indentation
   2776 			  (org-element-property :preserve-indent element))
   2777 		      new-body
   2778 		    (with-temp-buffer
   2779 		      (insert (org-remove-indentation new-body))
   2780 		      (indent-rigidly
   2781 		       (point-min)
   2782 		       (point-max)
   2783 		       (+ ind org-edit-src-content-indentation))
   2784 		      (buffer-string))))))
   2785       (delete-region body-start
   2786 		     (org-with-wide-buffer
   2787 		      (goto-char (org-element-property :end element))
   2788 		      (skip-chars-backward " \t\n")
   2789 		      (line-beginning-position)))
   2790       (goto-char body-start)
   2791       (insert body))))
   2792 
   2793 (defun org-babel-merge-params (&rest plists)
   2794   "Combine all parameter association lists in PLISTS.
   2795 Later elements of PLISTS override the values of previous elements.
   2796 This takes into account some special considerations for certain
   2797 parameters when merging lists."
   2798   (let* ((results-exclusive-groups
   2799 	  (mapcar (lambda (group) (mapcar #'symbol-name group))
   2800 		  (cdr (assq 'results org-babel-common-header-args-w-values))))
   2801 	 (exports-exclusive-groups
   2802 	  (mapcar (lambda (group) (mapcar #'symbol-name group))
   2803 		  (cdr (assq 'exports org-babel-common-header-args-w-values))))
   2804 	 (merge
   2805 	  (lambda (exclusive-groups &rest result-params)
   2806 	    ;; Maintain exclusivity of mutually exclusive parameters,
   2807 	    ;; as defined in EXCLUSIVE-GROUPS while merging lists in
   2808 	    ;; RESULT-PARAMS.
   2809 	    (let (output)
   2810 	      (dolist (new-params result-params (delete-dups output))
   2811 		(dolist (new-param new-params)
   2812 		  (dolist (exclusive-group exclusive-groups)
   2813 		    (when (member new-param exclusive-group)
   2814 		      (setq output (cl-remove-if
   2815 				    (lambda (o) (member o exclusive-group))
   2816 				    output))))
   2817 		  (push new-param output))))))
   2818 	 (variable-index 0)		;Handle positional arguments.
   2819 	 clearnames
   2820 	 params				;Final parameters list.
   2821 	 ;; Some keywords accept multiple values.  We need to treat
   2822 	 ;; them specially.
   2823 	 vars results exports)
   2824     (dolist (plist plists)
   2825       (dolist (pair plist)
   2826 	(pcase pair
   2827 	  (`(:var . ,value)
   2828 	   (let ((name (cond
   2829                         ;; Default header arguments can accept lambda
   2830                         ;; functions.  We uniquely identify the var
   2831                         ;; according to the full string contents of
   2832                         ;; the lambda function.
   2833 			((functionp value) value)
   2834 			((listp value) (car value))
   2835 			((string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=" value)
   2836 			 (intern (match-string 1 value)))
   2837 			(t nil))))
   2838 	     (cond
   2839 	      (name
   2840 	       (setq vars
   2841 		     (append (if (not (assoc name vars)) vars
   2842 			       (push name clearnames)
   2843 			       (cl-remove-if (lambda (p) (equal name (car p)))
   2844 					     vars))
   2845 			     (list (cons name pair)))))
   2846 	      ((and vars (nth variable-index vars))
   2847 	       ;; If no name is given and we already have named
   2848 	       ;; variables then assign to named variables in order.
   2849 	       (let ((name (car (nth variable-index vars))))
   2850 		 ;; Clear out colnames and rownames for replace vars.
   2851 		 (push name clearnames)
   2852 		 (setf (cddr (nth variable-index vars))
   2853 		       (concat (symbol-name name) "=" value))
   2854 		 (cl-incf variable-index)))
   2855 	      (t (error "Variable \"%s\" must be assigned a default value"
   2856 			(cdr pair))))))
   2857 	  (`(:results . ,value)
   2858 	   (setq results (funcall merge
   2859 				  results-exclusive-groups
   2860 				  results
   2861 				  (split-string
   2862 				   (cond ((stringp value) value)
   2863                                          ((functionp value) (funcall value))
   2864                                          ;; FIXME: Arbitrary code evaluation.
   2865                                          (t (eval value t)))))))
   2866 	  (`(:exports . ,value)
   2867 	   (setq exports (funcall merge
   2868 				  exports-exclusive-groups
   2869 				  exports
   2870                                   (split-string
   2871                                    (cond ((and value (functionp value)) (funcall value))
   2872                                          (value value)
   2873                                          (t ""))))))
   2874           ((or '(:dir . attach) '(:dir . "'attach"))
   2875            (unless (org-attach-dir nil t)
   2876              (error "No attachment directory for element (add :ID: or :DIR: property)"))
   2877            (setq params (append
   2878                          `((:dir . ,(org-attach-dir nil t))
   2879                            (:mkdirp . "yes"))
   2880                          (assq-delete-all :dir (assq-delete-all :mkdir params)))))
   2881 	  ;; Regular keywords: any value overwrites the previous one.
   2882 	  (_ (setq params (cons pair (assq-delete-all (car pair) params)))))))
   2883     ;; Handle `:var' and clear out colnames and rownames for replaced
   2884     ;; variables.
   2885     (setq params (nconc (mapcar (lambda (v) (cons :var (cddr v))) vars)
   2886 			params))
   2887     (dolist (name clearnames)
   2888       (dolist (param '(:colname-names :rowname-names))
   2889 	(when (assq param params)
   2890 	  (setf (cdr (assq param params))
   2891 		(cl-remove-if (lambda (pair) (equal name (car pair)))
   2892 			      (cdr (assq param params))))
   2893 	  (setq params
   2894 		(cl-remove-if (lambda (pair) (and (equal (car pair) param)
   2895 						  (null (cdr pair))))
   2896 			      params)))))
   2897     ;; Handle other special keywords, which accept multiple values.
   2898     (setq params (nconc (list (cons :results (mapconcat #'identity results " "))
   2899 			      (cons :exports (mapconcat #'identity exports " ")))
   2900 			params))
   2901     ;; Return merged params.
   2902     (org-babel-eval-headers params)))
   2903 
   2904 (defun org-babel-noweb-p (params context)
   2905   "Check if PARAMS require expansion in CONTEXT.
   2906 CONTEXT may be one of :tangle, :export or :eval."
   2907   (let ((allowed-values (cl-case context
   2908 			  (:tangle '("yes" "tangle" "no-export" "strip-export" "strip-tangle"))
   2909 			  (:eval   '("yes" "no-export" "strip-export" "eval" "strip-tangle"))
   2910 			  (:export '("yes" "strip-tangle")))))
   2911     (cl-some (lambda (v) (member v allowed-values))
   2912 	     (split-string (or (cdr (assq :noweb params)) "")))))
   2913 
   2914 (defvar org-babel-expand-noweb-references--cache nil
   2915   "Noweb reference cache used during expansion.")
   2916 (defvar org-babel-expand-noweb-references--cache-buffer nil
   2917   "Cons (BUFFER . MODIFIED-TICK) for cached noweb references.
   2918 See `org-babel-expand-noweb-references--cache'.")
   2919 (defun org-babel-expand-noweb-references (&optional info parent-buffer)
   2920   "Expand Noweb references in the body of the current source code block.
   2921 
   2922 For example the following reference would be replaced with the
   2923 body of the source-code block named `example-block'.
   2924 
   2925 <<example-block>>
   2926 
   2927 Note that any text preceding the <<foo>> construct on a line will
   2928 be interposed between the lines of the replacement text.  So for
   2929 example if <<foo>> is placed behind a comment, then the entire
   2930 replacement text will also be commented.
   2931 
   2932 This function must be called from inside of the buffer containing
   2933 the source-code block which holds BODY.
   2934 
   2935 In addition the following syntax can be used to insert the
   2936 results of evaluating the source-code block named `example-block'.
   2937 
   2938 <<example-block()>>
   2939 
   2940 Any optional arguments can be passed to example-block by placing
   2941 the arguments inside the parenthesis following the convention
   2942 defined by `org-babel-lob'.  For example
   2943 
   2944 <<example-block(a=9)>>
   2945 
   2946 would set the value of argument \"a\" equal to \"9\".  Note that
   2947 these arguments are not evaluated in the current source-code
   2948 block but are passed literally to the \"example-block\"."
   2949   (let* ((parent-buffer (or parent-buffer (current-buffer)))
   2950 	 (info (or info (org-babel-get-src-block-info 'no-eval)))
   2951          (lang (nth 0 info))
   2952          (body (nth 1 info))
   2953 	 (comment (string= "noweb" (cdr (assq :comments (nth 2 info)))))
   2954          (noweb-prefix (let ((v (assq :noweb-prefix (nth 2 info))))
   2955                          (or (not v)
   2956                              (and (org-not-nil (cdr v))
   2957                                   (not (equal (cdr v) "no"))))))
   2958 	 (noweb-re (format "\\(.*?\\)\\(%s\\)"
   2959 			   (with-current-buffer parent-buffer
   2960 			     (org-babel-noweb-wrap)))))
   2961     (unless (equal (cons parent-buffer
   2962                          (with-current-buffer parent-buffer
   2963                            (buffer-chars-modified-tick)))
   2964                    org-babel-expand-noweb-references--cache-buffer)
   2965       (setq org-babel-expand-noweb-references--cache nil
   2966             org-babel-expand-noweb-references--cache-buffer
   2967             (cons parent-buffer
   2968                   (with-current-buffer parent-buffer
   2969                     (buffer-chars-modified-tick)))))
   2970     (cl-macrolet ((c-wrap
   2971 	           (s)
   2972 	           ;; Comment string S, according to LANG mode.  Return new
   2973 	           ;; string.
   2974 	           `(unless org-babel-tangle-uncomment-comments
   2975 	              (with-temp-buffer
   2976 		        (funcall (org-src-get-lang-mode lang))
   2977 		        (comment-region (point)
   2978 				        (progn (insert ,s) (point)))
   2979 		        (org-trim (buffer-string)))))
   2980 	          (expand-body
   2981 	           (i)
   2982 	           ;; Expand body of code represented by block info I.
   2983 	           `(let ((b (if (org-babel-noweb-p (nth 2 ,i) :eval)
   2984 			         (org-babel-expand-noweb-references ,i)
   2985 		               (nth 1 ,i))))
   2986 	              (if (not comment) b
   2987 		        (let ((cs (org-babel-tangle-comment-links ,i)))
   2988 		          (concat (c-wrap (car cs)) "\n"
   2989 			          b "\n"
   2990 			          (c-wrap (cadr cs)))))))
   2991 	          (expand-references
   2992 	           (ref)
   2993 	           `(pcase (gethash ,ref org-babel-expand-noweb-references--cache)
   2994 	              (`(,last . ,previous)
   2995 	               ;; Ignore separator for last block.
   2996 	               (let ((strings (list (expand-body last))))
   2997 		         (dolist (i previous)
   2998 		           (let ((parameters (nth 2 i)))
   2999 		             ;; Since we're operating in reverse order, first
   3000 		             ;; push separator, then body.
   3001 		             (push (or (cdr (assq :noweb-sep parameters)) "\n")
   3002 			           strings)
   3003 		             (push (expand-body i) strings)))
   3004 		         (mapconcat #'identity strings "")))
   3005 	              ;; Raise an error about missing reference, or return the
   3006 	              ;; empty string.
   3007 	              ((guard (or org-babel-noweb-error-all-langs
   3008 			          (member lang org-babel-noweb-error-langs)))
   3009 	               (error "Cannot resolve %s (see `org-babel-noweb-error-langs')"
   3010 		              (org-babel-noweb-wrap ,ref)))
   3011 	              (_ ""))))
   3012       (replace-regexp-in-string
   3013        noweb-re
   3014        (lambda (m)
   3015          (with-current-buffer parent-buffer
   3016 	   (save-match-data
   3017 	     (let* ((prefix (match-string 1 m))
   3018 		    (id (match-string 3 m))
   3019 		    (evaluate (string-match-p "(.*)" id))
   3020 		    (expansion
   3021 		     (cond
   3022 		      (evaluate
   3023                        (prog1
   3024 		           (let ((raw (org-babel-ref-resolve id)))
   3025 		             (if (stringp raw) raw (format "%S" raw)))
   3026                          ;; Evaluation can potentially modify the buffer
   3027 		         ;; and invalidate the cache: reset it.
   3028                          (unless (equal org-babel-expand-noweb-references--cache-buffer
   3029                                         (cons parent-buffer
   3030                                               (buffer-chars-modified-tick)))
   3031 		           (setq org-babel-expand-noweb-references--cache nil
   3032                                  org-babel-expand-noweb-references--cache-buffer
   3033                                  (cons parent-buffer
   3034                                        (with-current-buffer parent-buffer
   3035                                          (buffer-chars-modified-tick)))))))
   3036                       ;; Already cached.
   3037                       ((and (hash-table-p org-babel-expand-noweb-references--cache)
   3038                             (gethash id org-babel-expand-noweb-references--cache))
   3039                        (expand-references id))
   3040 		      ;; Return the contents of headlines literally.
   3041 		      ((org-babel-ref-goto-headline-id id)
   3042 		       (org-babel-ref-headline-body))
   3043 		      ;; Look for a source block named SOURCE-NAME.  If
   3044 		      ;; found, assume it is unique; do not look after
   3045 		      ;; `:noweb-ref' header argument.
   3046 		      ((org-with-point-at 1
   3047 		         (let ((r (org-babel-named-src-block-regexp-for-name id)))
   3048 			   (and (re-search-forward r nil t)
   3049 			        (not (org-in-commented-heading-p))
   3050                                 (let ((info (org-babel-get-src-block-info t)))
   3051                                   (unless (hash-table-p org-babel-expand-noweb-references--cache)
   3052                                     (setq org-babel-expand-noweb-references--cache (make-hash-table :test #'equal)))
   3053                                   (push info (gethash id  org-babel-expand-noweb-references--cache))
   3054 			          (expand-body info))))))
   3055 		      ;; Retrieve from the Library of Babel.
   3056 		      ((nth 2 (assoc-string id org-babel-library-of-babel)))
   3057 		      ;; All Noweb references were cached in a previous
   3058 		      ;; run.  Yet, ID is not in cache (see the above
   3059 		      ;; condition).  Process missing reference in
   3060 		      ;; `expand-references'.
   3061 		      ((and (hash-table-p org-babel-expand-noweb-references--cache)
   3062                             (gethash 'buffer-processed org-babel-expand-noweb-references--cache))
   3063 		       (expand-references id))
   3064 		      ;; Though luck.  We go into the long process of
   3065 		      ;; checking each source block and expand those
   3066 		      ;; with a matching Noweb reference.  Since we're
   3067 		      ;; going to visit all source blocks in the
   3068 		      ;; document, cache information about them as well.
   3069 		      (t
   3070 		       (setq org-babel-expand-noweb-references--cache (make-hash-table :test #'equal))
   3071 		       (org-with-wide-buffer
   3072 		        (org-babel-map-src-blocks nil
   3073 			  (if (org-in-commented-heading-p)
   3074 			      (org-forward-heading-same-level nil t)
   3075 			    (let* ((info (org-babel-get-src-block-info t))
   3076 				   (ref (cdr (assq :noweb-ref (nth 2 info)))))
   3077 			      (push info (gethash ref org-babel-expand-noweb-references--cache))))))
   3078                        (puthash 'buffer-processed t org-babel-expand-noweb-references--cache)
   3079 		       (expand-references id)))))
   3080 	       ;; Interpose PREFIX between every line.
   3081                (if noweb-prefix
   3082 		   (mapconcat #'identity
   3083 			      (split-string expansion "[\n\r]")
   3084 			      (concat "\n" prefix))
   3085                  expansion)))))
   3086        body t t 2))))
   3087 
   3088 (defun org-babel--script-escape-inner (str)
   3089   (let (in-single in-double backslash out)
   3090     (mapc
   3091      (lambda (ch)
   3092        (setq
   3093 	out
   3094 	(if backslash
   3095 	    (progn
   3096 	      (setq backslash nil)
   3097 	      (cond
   3098 	       ((and in-single (eq ch ?'))
   3099 		;; Escaped single quote inside single quoted string:
   3100 		;; emit just a single quote, since we've changed the
   3101 		;; outer quotes to double.
   3102 		(cons ch out))
   3103 	       ((eq ch ?\")
   3104 		;; Escaped double quote
   3105 		(if in-single
   3106 		    ;; This should be interpreted as backslash+quote,
   3107 		    ;; not an escape.  Emit a three backslashes
   3108 		    ;; followed by a quote (because one layer of
   3109 		    ;; quoting will be stripped by `org-babel-read').
   3110 		    (append (list ch ?\\ ?\\ ?\\) out)
   3111 		  ;; Otherwise we are in a double-quoted string.  Emit
   3112 		  ;; a single escaped quote
   3113 		  (append (list ch ?\\) out)))
   3114 	       ((eq ch ?\\)
   3115 		;; Escaped backslash: emit a single escaped backslash
   3116 		(append (list ?\\ ?\\) out))
   3117 	       ;; Other: emit a quoted backslash followed by whatever
   3118 	       ;; the character was (because one layer of quoting will
   3119 	       ;; be stripped by `org-babel-read').
   3120 	       (t (append (list ch ?\\ ?\\) out))))
   3121 	  (cl-case ch
   3122 	    (?\[ (if (or in-double in-single)
   3123 		     (cons ?\[ out)
   3124 		   (cons ?\( out)))
   3125 	    (?\] (if (or in-double in-single)
   3126 		     (cons ?\] out)
   3127 		   (cons ?\) out)))
   3128 	    (?\{ (if (or in-double in-single)
   3129 		     (cons ?\{ out)
   3130 		   (cons ?\( out)))
   3131 	    (?\} (if (or in-double in-single)
   3132 		     (cons ?\} out)
   3133 		   (cons ?\) out)))
   3134 	    (?, (if (or in-double in-single)
   3135 		    (cons ?, out) (cons ?\s out)))
   3136 	    (?\' (if in-double
   3137 		     (cons ?\' out)
   3138 		   (setq in-single (not in-single)) (cons ?\" out)))
   3139 	    (?\" (if in-single
   3140 		     (append (list ?\" ?\\) out)
   3141 		   (setq in-double (not in-double)) (cons ?\" out)))
   3142 	    (?\\ (unless (or in-single in-double)
   3143 		   (error "Can't handle backslash outside string in `org-babel-script-escape'"))
   3144 		 (setq backslash t)
   3145 		 out)
   3146 	    (t  (cons ch out))))))
   3147      (string-to-list str))
   3148     (when (or in-single in-double)
   3149       (error "Unterminated string in `org-babel-script-escape'"))
   3150     (apply #'string (reverse out))))
   3151 
   3152 (defun org-babel-script-escape (str &optional force)
   3153   "Safely convert tables into elisp lists."
   3154   (unless (stringp str)
   3155     (error "`org-babel-script-escape' expects a string"))
   3156   (let ((escaped
   3157 	 (cond
   3158 	  ((and (>= (length str) 2)
   3159 		(or (and (string-equal "[" (substring str 0 1))
   3160 			 (string-equal "]" (substring str -1)))
   3161 		    (and (string-equal "{" (substring str 0 1))
   3162 			 (string-equal "}" (substring str -1)))
   3163 		    (and (string-equal "(" (substring str 0 1))
   3164 			 (string-equal ")" (substring str -1)))))
   3165 
   3166 	   (concat "'" (org-babel--script-escape-inner str)))
   3167 	  ((or force
   3168 	       (and (> (length str) 2)
   3169 		    (or (and (string-equal "'" (substring str 0 1))
   3170 			     (string-equal "'" (substring str -1)))
   3171 			;; We need to pass double-quoted strings
   3172 			;; through the backslash-twiddling bits, even
   3173 			;; though we don't need to change their
   3174 			;; delimiters.
   3175 			(and (string-equal "\"" (substring str 0 1))
   3176 			     (string-equal "\"" (substring str -1))))))
   3177 	   (org-babel--script-escape-inner str))
   3178 	  (t str))))
   3179     (condition-case nil (org-babel-read escaped) (error escaped))))
   3180 
   3181 (defun org-babel-read (cell &optional inhibit-lisp-eval)
   3182   "Convert the string value of CELL to a number if appropriate.
   3183 Otherwise if CELL looks like Lisp (meaning it starts with a
   3184 \"(\", \"\\='\", \"\\=`\" or a \"[\") then read and evaluate it as
   3185 lisp, otherwise return it unmodified as a string.  Optional
   3186 argument INHIBIT-LISP-EVAL inhibits lisp evaluation for
   3187 situations in which is it not appropriate."
   3188   (cond ((not (org-string-nw-p cell)) cell)
   3189 	((org-babel--string-to-number cell))
   3190 	((and (not inhibit-lisp-eval)
   3191 	      (or (memq (string-to-char cell) '(?\( ?' ?` ?\[))
   3192 		  (string= cell "*this*")))
   3193          ;; FIXME: Arbitrary code evaluation.
   3194 	 (eval (read cell) t))
   3195 	((save-match-data
   3196            (and (string-match "^[[:space:]]*\"\\(.*\\)\"[[:space:]]*$" cell)
   3197                 (not (string-match "[^\\]\"" (match-string 1 cell)))))
   3198          (read cell))
   3199 	(t (org-no-properties cell))))
   3200 
   3201 (defun org-babel--string-to-number (string)
   3202   "If STRING represents a number return its value.
   3203 Otherwise return nil."
   3204   (unless (or (string-match-p "\\s-" (org-trim string))
   3205 	      (not (string-match-p "^[0-9e.+ -]+$" string)))
   3206     (let ((interned-string (ignore-errors (read string))))
   3207       (when (numberp interned-string)
   3208 	interned-string))))
   3209 
   3210 (defun org-babel-import-elisp-from-file (file-name &optional separator)
   3211   "Read the results located at FILE-NAME into an elisp table.
   3212 If the table is trivial, then return it as a scalar."
   3213   (let ((result
   3214 	 (with-temp-buffer
   3215 	   (condition-case err
   3216 	       (progn
   3217 		 (insert-file-contents file-name)
   3218 		 (delete-file file-name)
   3219 		 (let ((pmax (point-max)))
   3220 		   ;; If the file was empty, don't bother trying to
   3221 		   ;; convert the table.
   3222 		   (when (> pmax 1)
   3223 		     (org-table-convert-region (point-min) pmax separator)
   3224 		     (delq nil
   3225 			   (mapcar (lambda (row)
   3226 				     (and (not (eq row 'hline))
   3227 					  (mapcar #'org-babel-string-read row)))
   3228 				   (org-table-to-lisp))))))
   3229 	     (error
   3230 	      (display-warning 'org-babel
   3231 			       (format "Error reading results: %S" err)
   3232 			       :error)
   3233 	      nil)))))
   3234     (pcase result
   3235       (`((,scalar)) scalar)
   3236       (`((,_ ,_ . ,_)) result)
   3237       (`(,scalar) scalar)
   3238       (_ result))))
   3239 
   3240 (defun org-babel-string-read (cell)
   3241   "Strip nested \"s from around strings."
   3242   (org-babel-read (or (and (stringp cell)
   3243                            (string-match "^[[:space:]]*\"\\(.+\\)\"[[:space:]]*$" cell)
   3244                            (match-string 1 cell))
   3245                       cell) t))
   3246 
   3247 (defun org-babel-chomp (string &optional regexp)
   3248   "Strip a trailing space or carriage return from STRING.
   3249 The default regexp used is \"[ \\f\\t\\n\\r\\v]\" but another one
   3250 can be specified as the REGEXP argument."
   3251   (let ((regexp (or regexp "[ \f\t\n\r\v]")))
   3252     (while (and (> (length string) 0)
   3253                 (string-match regexp (substring string -1)))
   3254       (setq string (substring string 0 -1)))
   3255     string))
   3256 
   3257 (defun org-babel-process-file-name (name &optional no-quote-p)
   3258   "Prepare NAME to be used in an external process.
   3259 If NAME specifies a remote location, the remote portion of the
   3260 name is removed, since in that case the process will be executing
   3261 remotely.  The file name is then processed by `expand-file-name'.
   3262 Unless second argument NO-QUOTE-P is non-nil, the file name is
   3263 additionally processed by `shell-quote-argument'."
   3264   (let ((f (org-babel-local-file-name (expand-file-name name))))
   3265     (if no-quote-p f (shell-quote-argument f))))
   3266 
   3267 (defvar org-babel-temporary-directory
   3268   (unless noninteractive
   3269     (make-temp-file "babel-" t))
   3270   "Directory to hold temporary files created to execute code blocks.
   3271 Used by `org-babel-temp-file'.  This directory will be removed on
   3272 Emacs shutdown.")
   3273 
   3274 (defvar org-babel-temporary-stable-directory
   3275   (unless noninteractive
   3276     (let (dir)
   3277       (while (or (not dir) (file-exists-p dir))
   3278         (setq dir (expand-file-name
   3279                    (format "babel-stable-%d" (random 1000))
   3280                    (temporary-file-directory))))
   3281       (make-directory dir)
   3282       dir))
   3283   "Directory to hold temporary files created to execute code blocks.
   3284 Used by `org-babel-temp-file'.  This directory will be removed on
   3285 Emacs shutdown.")
   3286 
   3287 (defcustom org-babel-remote-temporary-directory "/tmp/"
   3288   "Directory to hold temporary files on remote hosts."
   3289   :group 'org-babel
   3290   :type 'string)
   3291 
   3292 (defmacro org-babel-result-cond (result-params scalar-form &rest table-forms)
   3293   "Call the code to parse raw string results according to RESULT-PARAMS."
   3294   (declare (indent 1) (debug t))
   3295   (org-with-gensyms (params)
   3296     `(let ((,params ,result-params))
   3297        (unless (member "discard" ,params)
   3298          (if (or (member "scalar" ,params)
   3299 	         (member "verbatim" ,params)
   3300 	         (member "html" ,params)
   3301 	         (member "code" ,params)
   3302 	         (member "pp" ,params)
   3303 	         (member "file" ,params)
   3304 	         (and (or (member "output" ,params)
   3305 			  (member "raw"    ,params)
   3306 			  (member "org"    ,params)
   3307 			  (member "drawer" ,params))
   3308 		      (not (member "table" ,params))))
   3309 	     ,scalar-form
   3310 	   ,@table-forms)))))
   3311 
   3312 (defmacro org-babel-temp-directory ()
   3313   "Return temporary directory suitable for `default-directory'."
   3314   `(if (file-remote-p default-directory)
   3315        (concat (file-remote-p default-directory)
   3316 	       org-babel-remote-temporary-directory)
   3317      (or (and org-babel-temporary-directory
   3318 	      (file-exists-p org-babel-temporary-directory)
   3319 	      org-babel-temporary-directory)
   3320 	 temporary-file-directory)))
   3321 
   3322 (defun org-babel-temp-file (prefix &optional suffix)
   3323   "Create a temporary file in the `org-babel-temporary-directory'.
   3324 Passes PREFIX and SUFFIX directly to `make-temp-file' with the
   3325 value of `temporary-file-directory' temporarily set to the value
   3326 of `org-babel-temporary-directory'."
   3327   (make-temp-file
   3328    (concat (file-name-as-directory (org-babel-temp-directory)) prefix)
   3329    nil
   3330    suffix))
   3331 
   3332 (defmacro org-babel-temp-stable-directory ()
   3333   "Return temporary stable directory."
   3334   `(let ((org-babel-temporary-directory org-babel-temporary-stable-directory))
   3335      (org-babel-temp-directory)))
   3336 
   3337 (defun org-babel-temp-stable-file (data prefix &optional suffix)
   3338   "Create a temporary file in the `org-babel-remove-temporary-stable-directory'.
   3339 The file name is stable with respect to DATA.  The file name is
   3340 constructed like the following: PREFIXDATAhashSUFFIX."
   3341   (let ((path
   3342          (format
   3343           "%s%s%s%s"
   3344           (file-name-as-directory (org-babel-temp-stable-directory))
   3345           prefix
   3346           (sxhash data)
   3347           (or suffix ""))))
   3348     ;; Create file.
   3349     (with-temp-file path)
   3350     ;; Return it.
   3351     path))
   3352 
   3353 (defun org-babel-remove-temporary-directory ()
   3354   "Remove `org-babel-temporary-directory' on Emacs shutdown."
   3355   (when (and org-babel-temporary-directory
   3356 	     (file-exists-p org-babel-temporary-directory))
   3357     ;; taken from `delete-directory' in files.el
   3358     (condition-case nil
   3359 	(progn
   3360 	  (mapc (lambda (file)
   3361 		  ;; This test is equivalent to
   3362 		  ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
   3363 		  ;; but more efficient
   3364 		  (if (eq t (car (file-attributes file)))
   3365 		      (delete-directory file)
   3366 		    (delete-file file)))
   3367 		(directory-files org-babel-temporary-directory 'full
   3368 				 directory-files-no-dot-files-regexp))
   3369 	  (delete-directory org-babel-temporary-directory))
   3370       (error
   3371        (message "Failed to remove temporary Org-babel directory %s"
   3372 		(or org-babel-temporary-directory
   3373 		    "[directory not defined]"))))))
   3374 
   3375 (defun org-babel-remove-temporary-stable-directory ()
   3376   "Remove `org-babel-temporary-stable-directory' and on Emacs shutdown."
   3377   (when (and org-babel-temporary-stable-directory
   3378 	     (file-exists-p org-babel-temporary-stable-directory))
   3379     (let ((org-babel-temporary-directory
   3380            org-babel-temporary-stable-directory))
   3381       (org-babel-remove-temporary-directory))))
   3382 
   3383 (add-hook 'kill-emacs-hook #'org-babel-remove-temporary-directory)
   3384 (add-hook 'kill-emacs-hook #'org-babel-remove-temporary-stable-directory)
   3385 
   3386 (defun org-babel-one-header-arg-safe-p (pair safe-list)
   3387   "Determine if the PAIR is a safe babel header arg according to SAFE-LIST.
   3388 
   3389 For the format of SAFE-LIST, see `org-babel-safe-header-args'."
   3390   (and (consp pair)
   3391        (keywordp (car pair))
   3392        (stringp (cdr pair))
   3393        (or
   3394 	(memq (car pair) safe-list)
   3395 	(let ((entry (assq (car pair) safe-list)))
   3396 	  (and entry
   3397 	       (consp entry)
   3398 	       (cond ((functionp (cdr entry))
   3399 		      (funcall (cdr entry) (cdr pair)))
   3400 		     ((listp (cdr entry))
   3401 		      (member (cdr pair) (cdr entry)))
   3402 		     (t nil)))))))
   3403 
   3404 (defun org-babel-generate-file-param (src-name params)
   3405   "Calculate the filename for source block results.
   3406 
   3407 The directory is calculated from the :output-dir property of the
   3408 source block; if not specified, use the current directory.
   3409 
   3410 If the source block has a #+NAME and the :file parameter does not
   3411 contain any period characters, then the :file parameter is
   3412 treated as an extension, and the output file name is the
   3413 concatenation of the directory (as calculated above), the block
   3414 name, a period, and the parameter value as a file extension.
   3415 Otherwise, the :file parameter is treated as a full file name,
   3416 and the output file name is the directory (as calculated above)
   3417 plus the parameter value."
   3418   (let* ((file-cons (assq :file params))
   3419 	 (file-ext-cons (assq :file-ext params))
   3420 	 (file-ext (cdr-safe file-ext-cons))
   3421 	 (dir (cdr-safe (assq :output-dir params)))
   3422 	 fname)
   3423     ;; create the output-dir if it does not exist
   3424     (when dir
   3425       (make-directory dir t))
   3426     (if file-cons
   3427 	;; :file given; add :output-dir if given
   3428 	(when dir
   3429 	  (setcdr file-cons (concat (file-name-as-directory dir) (cdr file-cons))))
   3430       ;; :file not given; compute from name and :file-ext if possible
   3431       (when (and src-name file-ext)
   3432 	(if dir
   3433 	    (setq fname (concat (file-name-as-directory (or dir ""))
   3434 				src-name "." file-ext))
   3435 	  (setq fname (concat src-name "." file-ext)))
   3436 	(setq params (cons (cons :file fname) params))))
   3437     params))
   3438 
   3439 (defun org-babel-graphical-output-file (params)
   3440   "File where a babel block should send graphical output, per PARAMS.
   3441 Return nil if no graphical output is expected.  Raise an error if
   3442 the output file is ill-defined."
   3443   (let ((file (cdr (assq :file params))))
   3444     (cond (file (and (member "graphics" (cdr (assq :result-params params)))
   3445 		     file))
   3446 	  ((assq :file-ext params)
   3447 	   (user-error ":file-ext given but no :file generated; did you forget \
   3448 to name a block?"))
   3449 	  (t (user-error "No :file header argument given; cannot create \
   3450 graphical result")))))
   3451 
   3452 (defun org-babel-make-language-alias (new old)
   3453   "Make source blocks of type NEW aliases for those of type OLD.
   3454 
   3455 NEW and OLD should be strings.  This function should be called
   3456 after the babel API for OLD-type source blocks is fully defined.
   3457 
   3458 Callers of this function will probably want to add an entry to
   3459 `org-src-lang-modes' as well."
   3460   (dolist (fn '("execute" "expand-body" "prep-session"
   3461 		"variable-assignments" "load-session"
   3462 		"edit-prep"))
   3463     (let ((sym (intern-soft (concat "org-babel-" fn ":" old))))
   3464       (when (and sym (fboundp sym))
   3465 	(defalias (intern (concat "org-babel-" fn ":" new)) sym))))
   3466   ;; Technically we don't need a `dolist' for just one variable, but
   3467   ;; we keep it for symmetry/ease of future expansion.
   3468   (dolist (var '("default-header-args"))
   3469     (let ((sym (intern-soft (concat "org-babel-" var ":" old))))
   3470       (when (and sym (boundp sym))
   3471 	(defvaralias (intern (concat "org-babel-" var ":" new)) sym)))))
   3472 
   3473 (provide 'ob-core)
   3474 
   3475 ;; Local variables:
   3476 ;; generated-autoload-file: "org-loaddefs.el"
   3477 ;; End:
   3478 
   3479 ;;; ob-core.el ends here