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