summaryrefslogtreecommitdiff
path: root/lisp/ob-core.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/ob-core.el')
-rw-r--r--lisp/ob-core.el302
1 files changed, 149 insertions, 153 deletions
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index cc6b7a9..84caed7 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -318,7 +318,7 @@ Do not query the user."
(message (format "Evaluation of this%scode-block%sis disabled."
code-block block-name))))))
- ;; dynamically scoped for asynchroneous export
+ ;; dynamically scoped for asynchronous export
(defvar org-babel-confirm-evaluate-answer-no)
(defsubst org-babel-confirm-evaluate (info)
@@ -632,15 +632,14 @@ block."
(message "result silenced")
(setq result nil))
(setq result
- ((lambda (result)
- (if (and (eq (cdr (assoc :result-type params))
- 'value)
- (or (member "vector" result-params)
- (member "table" result-params))
- (not (listp result)))
- (list (list result)) result))
- (funcall cmd body params)))
- ;; if non-empty result and :file then write to :file
+ (let ((result (funcall cmd body params)))
+ (if (and (eq (cdr (assoc :result-type params))
+ 'value)
+ (or (member "vector" result-params)
+ (member "table" result-params))
+ (not (listp result)))
+ (list (list result)) result)))
+ ;; If non-empty result and :file then write to :file.
(when (cdr (assoc :file params))
(when result
(with-temp-file (cdr (assoc :file params))
@@ -648,7 +647,7 @@ block."
(org-babel-format-result
result (cdr (assoc :sep (nth 2 info)))))))
(setq result (cdr (assoc :file params))))
- ;; possibly perform post process provided its appropriate
+ ;; Possibly perform post process provided its appropriate.
(when (cdr (assoc :post params))
(let ((*this* (if (cdr (assoc :file params))
(org-babel-result-to-file
@@ -893,6 +892,8 @@ with a prefix argument then this is passed on to
(defalias 'org-babel-pop-to-session 'org-babel-switch-to-session)
+(defvar org-src-window-setup)
+
;;;###autoload
(defun org-babel-switch-to-session-with-code (&optional arg info)
"Switch to code buffer and display session."
@@ -1157,18 +1158,18 @@ the current subtree."
(mapconcat #'identity (sort (funcall rm (split-string v))
#'string<) " "))
(t v)))))))
- ((lambda (hash)
- (when (org-called-interactively-p 'interactive) (message hash)) hash)
- (let ((it (format "%s-%s"
- (mapconcat
- #'identity
- (delq nil (mapcar (lambda (arg)
- (let ((normalized (funcall norm arg)))
- (when normalized
- (format "%S" normalized))))
- (nth 2 info))) ":")
- (nth 1 info))))
- (sha1 it))))))
+ (let* ((it (format "%s-%s"
+ (mapconcat
+ #'identity
+ (delq nil (mapcar (lambda (arg)
+ (let ((normalized (funcall norm arg)))
+ (when normalized
+ (format "%S" normalized))))
+ (nth 2 info))) ":")
+ (nth 1 info)))
+ (hash (sha1 it)))
+ (when (org-called-interactively-p 'interactive) (message hash))
+ hash))))
(defun org-babel-current-result-hash ()
"Return the current in-buffer hash."
@@ -1453,9 +1454,8 @@ instances of \"[ \t]:\" set ALTS to '((32 9) . 58)."
(cons (intern (match-string 1 arg))
(org-babel-read (org-babel-chomp (match-string 2 arg))))
(cons (intern (org-babel-chomp arg)) nil)))
- ((lambda (raw)
- (cons (car raw) (mapcar (lambda (r) (concat ":" r)) (cdr raw))))
- (org-babel-balanced-split arg-string '((32 9) . 58))))))))
+ (let ((raw (org-babel-balanced-split arg-string '((32 9) . 58))))
+ (cons (car raw) (mapcar (lambda (r) (concat ":" r)) (cdr raw)))))))))
(defun org-babel-parse-multiple-vars (header-arguments)
"Expand multiple variable assignments behind a single :var keyword.
@@ -1598,12 +1598,11 @@ of the vars, cnames and rnames."
Given a TABLE and set of COLNAMES and ROWNAMES add the names
to the table for reinsertion to org-mode."
(if (listp table)
- ((lambda (table)
- (if (and colnames (listp (car table)) (= (length (car table))
- (length colnames)))
- (org-babel-put-colnames table colnames) table))
- (if (and rownames (= (length table) (length rownames)))
- (org-babel-put-rownames table rownames) table))
+ (let ((table (if (and rownames (= (length table) (length rownames)))
+ (org-babel-put-rownames table rownames) table)))
+ (if (and colnames (listp (car table)) (= (length (car table))
+ (length colnames)))
+ (org-babel-put-colnames table colnames) table))
table))
(defun org-babel-where-is-src-block-head ()
@@ -1640,9 +1639,8 @@ If the point is not on a source block then return nil."
(defun org-babel-goto-src-block-head ()
"Go to the beginning of the current code block."
(interactive)
- ((lambda (head)
- (if head (goto-char head) (error "Not currently in a code block")))
- (org-babel-where-is-src-block-head)))
+ (let ((head (org-babel-where-is-src-block-head)))
+ (if head (goto-char head) (error "Not currently in a code block"))))
;;;###autoload
(defun org-babel-goto-named-src-block (name)
@@ -1763,14 +1761,13 @@ With optional prefix argument ARG, jump backward ARG many source blocks."
(defun org-babel-mark-block ()
"Mark current src block."
(interactive)
- ((lambda (head)
- (when head
- (save-excursion
- (goto-char head)
- (looking-at org-babel-src-block-regexp))
- (push-mark (match-end 5) nil t)
- (goto-char (match-beginning 5))))
- (org-babel-where-is-src-block-head)))
+ (let ((head (org-babel-where-is-src-block-head)))
+ (when head
+ (save-excursion
+ (goto-char head)
+ (looking-at org-babel-src-block-regexp))
+ (push-mark (match-end 5) nil t)
+ (goto-char (match-beginning 5)))))
(defun org-babel-demarcate-block (&optional arg)
"Wrap or split the code in the region or on the point.
@@ -2450,7 +2447,7 @@ block but are passed literally to the \"example-block\"."
(funcall (intern (concat lang "-mode")))
(comment-region (point) (progn (insert text) (point)))
(org-babel-trim (buffer-string)))))
- index source-name evaluate prefix blocks-in-buffer)
+ index source-name evaluate prefix)
(with-temp-buffer
(org-set-local 'org-babel-noweb-wrap-start ob-nww-start)
(org-set-local 'org-babel-noweb-wrap-end ob-nww-end)
@@ -2469,119 +2466,118 @@ block but are passed literally to the \"example-block\"."
(funcall nb-add (buffer-substring index (point)))
(goto-char (match-end 0))
(setq index (point))
- (funcall nb-add
- (with-current-buffer parent-buffer
- (save-restriction
- (widen)
- (mapconcat ;; interpose PREFIX between every line
- #'identity
- (split-string
- (if evaluate
- (let ((raw (org-babel-ref-resolve source-name)))
- (if (stringp raw) raw (format "%S" raw)))
- (or
- ;; retrieve from the library of babel
- (nth 2 (assoc (intern source-name)
- org-babel-library-of-babel))
- ;; return the contents of headlines literally
- (save-excursion
- (when (org-babel-ref-goto-headline-id source-name)
+ (funcall
+ nb-add
+ (with-current-buffer parent-buffer
+ (save-restriction
+ (widen)
+ (mapconcat ;; Interpose PREFIX between every line.
+ #'identity
+ (split-string
+ (if evaluate
+ (let ((raw (org-babel-ref-resolve source-name)))
+ (if (stringp raw) raw (format "%S" raw)))
+ (or
+ ;; Retrieve from the library of babel.
+ (nth 2 (assoc (intern source-name)
+ org-babel-library-of-babel))
+ ;; Return the contents of headlines literally.
+ (save-excursion
+ (when (org-babel-ref-goto-headline-id source-name)
(org-babel-ref-headline-body)))
- ;; find the expansion of reference in this buffer
- (let ((rx (concat rx-prefix source-name "[ \t\n]"))
- expansion)
- (save-excursion
- (goto-char (point-min))
- (if org-babel-use-quick-and-dirty-noweb-expansion
- (while (re-search-forward rx nil t)
- (let* ((i (org-babel-get-src-block-info 'light))
- (body (org-babel-expand-noweb-references i))
- (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
- "\n"))
- (full (if comment
- ((lambda (cs)
- (concat (funcall c-wrap (car cs)) "\n"
- body "\n"
- (funcall c-wrap (cadr cs))))
- (org-babel-tangle-comment-links i))
- body)))
- (setq expansion (cons sep (cons full expansion)))))
- (org-babel-map-src-blocks nil
- (let ((i (org-babel-get-src-block-info 'light)))
- (when (equal (or (cdr (assoc :noweb-ref (nth 2 i)))
- (nth 4 i))
- source-name)
- (let* ((body (org-babel-expand-noweb-references i))
- (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
- "\n"))
- (full (if comment
- ((lambda (cs)
- (concat (funcall c-wrap (car cs)) "\n"
- body "\n"
- (funcall c-wrap (cadr cs))))
- (org-babel-tangle-comment-links i))
- body)))
- (setq expansion
- (cons sep (cons full expansion)))))))))
- (and expansion
- (mapconcat #'identity (nreverse (cdr expansion)) "")))
- ;; possibly raise an error if named block doesn't exist
- (if (member lang org-babel-noweb-error-langs)
- (error "%s" (concat
- (org-babel-noweb-wrap source-name)
- "could not be resolved (see "
- "`org-babel-noweb-error-langs')"))
- "")))
- "[\n\r]") (concat "\n" prefix))))))
+ ;; Find the expansion of reference in this buffer.
+ (let ((rx (concat rx-prefix source-name "[ \t\n]"))
+ expansion)
+ (save-excursion
+ (goto-char (point-min))
+ (if org-babel-use-quick-and-dirty-noweb-expansion
+ (while (re-search-forward rx nil t)
+ (let* ((i (org-babel-get-src-block-info 'light))
+ (body (org-babel-expand-noweb-references i))
+ (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
+ "\n"))
+ (full (if comment
+ (let ((cs (org-babel-tangle-comment-links i)))
+ (concat (funcall c-wrap (car cs)) "\n"
+ body "\n"
+ (funcall c-wrap (cadr cs))))
+ body)))
+ (setq expansion (cons sep (cons full expansion)))))
+ (org-babel-map-src-blocks nil
+ (let ((i (org-babel-get-src-block-info 'light)))
+ (when (equal (or (cdr (assoc :noweb-ref (nth 2 i)))
+ (nth 4 i))
+ source-name)
+ (let* ((body (org-babel-expand-noweb-references i))
+ (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
+ "\n"))
+ (full (if comment
+ (let ((cs (org-babel-tangle-comment-links i)))
+ (concat (funcall c-wrap (car cs)) "\n"
+ body "\n"
+ (funcall c-wrap (cadr cs))))
+ body)))
+ (setq expansion
+ (cons sep (cons full expansion)))))))))
+ (and expansion
+ (mapconcat #'identity (nreverse (cdr expansion)) "")))
+ ;; Possibly raise an error if named block doesn't exist.
+ (if (member lang org-babel-noweb-error-langs)
+ (error "%s" (concat
+ (org-babel-noweb-wrap source-name)
+ "could not be resolved (see "
+ "`org-babel-noweb-error-langs')"))
+ "")))
+ "[\n\r]") (concat "\n" prefix))))))
(funcall nb-add (buffer-substring index (point-max))))
new-body))
(defun org-babel-script-escape (str &optional force)
"Safely convert tables into elisp lists."
- (let (in-single in-double out)
- ((lambda (escaped) (condition-case nil (org-babel-read escaped) (error escaped)))
- (if (or force
- (and (stringp str)
- (> (length str) 2)
- (or (and (string-equal "[" (substring str 0 1))
- (string-equal "]" (substring str -1)))
- (and (string-equal "{" (substring str 0 1))
- (string-equal "}" (substring str -1)))
- (and (string-equal "(" (substring str 0 1))
- (string-equal ")" (substring str -1))))))
- (org-babel-read
- (concat
- "'"
- (progn
- (mapc
- (lambda (ch)
- (setq
- out
- (case ch
- (91 (if (or in-double in-single) ; [
- (cons 91 out)
- (cons 40 out)))
- (93 (if (or in-double in-single) ; ]
- (cons 93 out)
- (cons 41 out)))
- (123 (if (or in-double in-single) ; {
- (cons 123 out)
- (cons 40 out)))
- (125 (if (or in-double in-single) ; }
- (cons 125 out)
- (cons 41 out)))
- (44 (if (or in-double in-single) ; ,
- (cons 44 out) (cons 32 out)))
- (39 (if in-double ; '
- (cons 39 out)
- (setq in-single (not in-single)) (cons 34 out)))
- (34 (if in-single ; "
- (append (list 34 32) out)
- (setq in-double (not in-double)) (cons 34 out)))
- (t (cons ch out)))))
- (string-to-list str))
- (apply #'string (reverse out)))))
- str))))
+ (let ((escaped
+ (if (or force
+ (and (stringp str)
+ (> (length str) 2)
+ (or (and (string-equal "[" (substring str 0 1))
+ (string-equal "]" (substring str -1)))
+ (and (string-equal "{" (substring str 0 1))
+ (string-equal "}" (substring str -1)))
+ (and (string-equal "(" (substring str 0 1))
+ (string-equal ")" (substring str -1))))))
+ (org-babel-read
+ (concat
+ "'"
+ (let (in-single in-double out)
+ (mapc
+ (lambda (ch)
+ (setq
+ out
+ (case ch
+ (91 (if (or in-double in-single) ; [
+ (cons 91 out)
+ (cons 40 out)))
+ (93 (if (or in-double in-single) ; ]
+ (cons 93 out)
+ (cons 41 out)))
+ (123 (if (or in-double in-single) ; {
+ (cons 123 out)
+ (cons 40 out)))
+ (125 (if (or in-double in-single) ; }
+ (cons 125 out)
+ (cons 41 out)))
+ (44 (if (or in-double in-single) ; ,
+ (cons 44 out) (cons 32 out)))
+ (39 (if in-double ; '
+ (cons 39 out)
+ (setq in-single (not in-single)) (cons 34 out)))
+ (34 (if in-single ; "
+ (append (list 34 32) out)
+ (setq in-double (not in-double)) (cons 34 out)))
+ (t (cons ch out)))))
+ (string-to-list str))
+ (apply #'string (reverse out)))))
+ str)))
+ (condition-case nil (org-babel-read escaped) (error escaped))))
(defun org-babel-read (cell &optional inhibit-lisp-eval)
"Convert the string value of CELL to a number if appropriate.
@@ -2691,8 +2687,8 @@ name is removed, since in that case the process will be executing
remotely. The file name is then processed by `expand-file-name'.
Unless second argument NO-QUOTE-P is non-nil, the file name is
additionally processed by `shell-quote-argument'"
- ((lambda (f) (if no-quote-p f (shell-quote-argument f)))
- (expand-file-name (org-babel-local-file-name name))))
+ (let ((f (expand-file-name (org-babel-local-file-name name))))
+ (if no-quote-p f (shell-quote-argument f))))
(defvar org-babel-temporary-directory)
(unless (or noninteractive (boundp 'org-babel-temporary-directory))