;;; ob.el --- working with code blocks in org-mode
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
-;; Author: Eric Schulte
+;; Authors: Eric Schulte
;; Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
(declare-function org-list-struct "org-list" ())
(declare-function org-list-prevs-alist "org-list" (struct))
(declare-function org-list-get-list-end "org-list" (item struct prevs))
+(declare-function org-strip-protective-commas "org" (beg end))
(defgroup org-babel nil
"Code block evaluation and management in `org-mode' documents."
`org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be used to
remove code block execution from the C-c C-c keybinding."
:group 'org-babel
+ :version "24.1"
:type '(choice boolean function))
;; don't allow this variable to be changed through file settings
(put 'org-confirm-babel-evaluate 'safe-local-variable (lambda (x) (eq x t)))
(defcustom org-babel-no-eval-on-ctrl-c-ctrl-c nil
"Remove code block evaluation from the C-c C-c key binding."
:group 'org-babel
+ :version "24.1"
:type 'boolean)
+(defcustom org-babel-results-keyword "RESULTS"
+ "Keyword used to name results generated by code blocks.
+Should be either RESULTS or NAME however any capitalization may
+be used."
+ :group 'org-babel
+ :type 'string)
+
(defvar org-babel-src-name-regexp
"^[ \t]*#\\+name:[ \t]*"
"Regular expression used to match a source name line.")
(first-line-p (= 1 (line-number-at-pos)))
(orig (point)))
(let ((search-for (cond ((and src-at-0-p first-line-p "src_"))
- (first-line-p "[ \t]src_")
- (t "[ \f\t\n\r\v]src_")))
+ (first-line-p "[[:punct:] \t]src_")
+ (t "[[:punct:] \f\t\n\r\v]src_")))
(lower-limit (if first-line-p
nil
(- (point-at-bol) 1))))
(noeval)
(noweb . ((yes no tangle)))
(noweb-ref . :any)
+ (noweb-sep . :any)
(padline . ((yes no)))
(results . ((file list vector table scalar verbatim)
(raw org html latex code pp wrap)
block."
(interactive)
(let ((info (or info (org-babel-get-src-block-info))))
- (when (org-babel-confirm-evaluate info)
+ (when (org-babel-confirm-evaluate
+ (let ((i info))
+ (setf (nth 2 i) (org-babel-merge-params (nth 2 info) params))
+ i))
(let* ((lang (nth 0 info))
(params (if params
(org-babel-process-params
;; TODO: report malformed code block
;; TODO: report incompatible combinations of header arguments
;; TODO: report uninitialized variables
- (let ((too-close 2)) ;; <- control closeness to report potential match
+ (let ((too-close 2) ;; <- control closeness to report potential match
+ (names (mapcar #'symbol-name org-babel-header-arg-names)))
(dolist (header (mapcar (lambda (arg) (substring (symbol-name (car arg)) 1))
(and (org-babel-where-is-src-block-head)
(org-babel-parse-header-arguments
(org-babel-clean-text-properties
(match-string 4))))))
- (dolist (name (mapcar #'symbol-name org-babel-header-arg-names))
+ (dolist (name names)
(when (and (not (string= header name))
- (<= (org-babel-edit-distance header name) too-close))
+ (<= (org-babel-edit-distance header name) too-close)
+ (not (member header names)))
(error "supplied header \"%S\" is suspiciously close to \"%S\""
header name))))
(message "No suspicious header arguments found.")))
(goto-char point))))
(def-edebug-spec org-babel-map-call-lines (form body))
+;;;###autoload
+(defmacro org-babel-map-executables (file &rest body)
+ (declare (indent 1))
+ (let ((tempvar (make-symbol "file"))
+ (rx (make-symbol "rx")))
+ `(let* ((,tempvar ,file)
+ (,rx (concat "\\(" org-babel-src-block-regexp
+ "\\|" org-babel-inline-src-block-regexp
+ "\\|" org-babel-lob-one-liner-regexp "\\)"))
+ (visited-p (or (null ,tempvar)
+ (get-file-buffer (expand-file-name ,tempvar))))
+ (point (point)) to-be-removed)
+ (save-window-excursion
+ (when ,tempvar (find-file ,tempvar))
+ (setq to-be-removed (current-buffer))
+ (goto-char (point-min))
+ (while (re-search-forward ,rx nil t)
+ (goto-char (match-beginning 1))
+ (when (looking-at org-babel-inline-src-block-regexp)(forward-char 1))
+ (save-match-data ,@body)
+ (goto-char (match-end 0))))
+ (unless visited-p (kill-buffer to-be-removed))
+ (goto-char point))))
+(def-edebug-spec org-babel-map-executables (form body))
+
;;;###autoload
(defun org-babel-execute-buffer (&optional arg)
"Execute source code blocks in a buffer.
(interactive "P")
(org-babel-eval-wipe-error-buffer)
(org-save-outline-visibility t
- (org-babel-map-src-blocks nil
- (org-babel-execute-src-block arg))
- (org-babel-map-inline-src-blocks nil
- (org-babel-execute-src-block arg))
- (org-babel-map-call-lines nil
- (org-babel-lob-execute-maybe))))
+ (org-babel-map-executables nil
+ (if (looking-at org-babel-lob-one-liner-regexp)
+ (org-babel-lob-execute-maybe)
+ (org-babel-execute-src-block arg)))))
;;;###autoload
(defun org-babel-execute-subtree (&optional arg)
(when hash (kill-new hash) (message hash))))
(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-hash-at-point)
+(defun org-babel-result-hide-spec ()
+ "Hide portions of results lines.
+Add `org-babel-hide-result' as an invisibility spec for hiding
+portions of results lines."
+ (add-to-invisibility-spec '(org-babel-hide-result . t)))
+(add-hook 'org-mode-hook 'org-babel-result-hide-spec)
+
+(defvar org-babel-hide-result-overlays nil
+ "Overlays hiding results.")
+
+(defun org-babel-result-hide-all ()
+ "Fold all results in the current buffer."
+ (interactive)
+ (org-babel-show-result-all)
+ (save-excursion
+ (while (re-search-forward org-babel-result-regexp nil t)
+ (save-excursion (goto-char (match-beginning 0))
+ (org-babel-hide-result-toggle-maybe)))))
+
+(defun org-babel-show-result-all ()
+ "Unfold all results in the current buffer."
+ (mapc 'delete-overlay org-babel-hide-result-overlays)
+ (setq org-babel-hide-result-overlays nil))
+
+;;;###autoload
+(defun org-babel-hide-result-toggle-maybe ()
+ "Toggle visibility of result at point."
+ (interactive)
+ (let ((case-fold-search t))
+ (if (save-excursion
+ (beginning-of-line 1)
+ (looking-at org-babel-result-regexp))
+ (progn (org-babel-hide-result-toggle)
+ t) ;; to signal that we took action
+ nil))) ;; to signal that we did not
+
+(defun org-babel-hide-result-toggle (&optional force)
+ "Toggle the visibility of the current result."
+ (interactive)
+ (save-excursion
+ (beginning-of-line)
+ (if (re-search-forward org-babel-result-regexp nil t)
+ (let ((start (progn (beginning-of-line 2) (- (point) 1)))
+ (end (progn
+ (while (looking-at org-babel-multi-line-header-regexp)
+ (forward-line 1))
+ (goto-char (- (org-babel-result-end) 1)) (point)))
+ ov)
+ (if (memq t (mapcar (lambda (overlay)
+ (eq (overlay-get overlay 'invisible)
+ 'org-babel-hide-result))
+ (overlays-at start)))
+ (if (or (not force) (eq force 'off))
+ (mapc (lambda (ov)
+ (when (member ov org-babel-hide-result-overlays)
+ (setq org-babel-hide-result-overlays
+ (delq ov org-babel-hide-result-overlays)))
+ (when (eq (overlay-get ov 'invisible)
+ 'org-babel-hide-result)
+ (delete-overlay ov)))
+ (overlays-at start)))
+ (setq ov (make-overlay start end))
+ (overlay-put ov 'invisible 'org-babel-hide-result)
+ ;; make the block accessible to isearch
+ (overlay-put
+ ov 'isearch-open-invisible
+ (lambda (ov)
+ (when (member ov org-babel-hide-result-overlays)
+ (setq org-babel-hide-result-overlays
+ (delq ov org-babel-hide-result-overlays)))
+ (when (eq (overlay-get ov 'invisible)
+ 'org-babel-hide-result)
+ (delete-overlay ov))))
+ (push ov org-babel-hide-result-overlays)))
+ (error "Not looking at a result line"))))
+
+;; org-tab-after-check-for-cycling-hook
+(add-hook 'org-tab-first-hook 'org-babel-hide-result-toggle-maybe)
+;; Remove overlays when changing major mode
+(add-hook 'org-mode-hook
+ (lambda () (org-add-hook 'change-major-mode-hook
+ 'org-babel-show-result-all 'append 'local)))
+
(defvar org-file-properties)
(defun org-babel-params-from-properties (&optional lang)
"Retrieve parameters specified as properties.
(substring body 0 sub-length)
(or body "")))))
(preserve-indentation (or org-src-preserve-indentation
- (string-match "-i\\>" switches))))
+ (save-match-data
+ (string-match "-i\\>" switches)))))
(list lang
;; get block body less properties, protective commas, and indentation
(with-temp-buffer
(save-match-data
- (insert (org-babel-strip-protective-commas body))
+ (insert (org-babel-strip-protective-commas body lang))
(unless preserve-indentation (org-do-remove-indentation))
(buffer-string)))
(org-babel-merge-params
(lang-headers (intern (concat "org-babel-default-header-args:" lang))))
(list lang
(org-babel-strip-protective-commas
- (org-babel-clean-text-properties (match-string 5)))
+ (org-babel-clean-text-properties (match-string 5)) lang)
(org-babel-merge-params
org-babel-default-inline-header-args
(org-babel-params-from-properties lang)
either the numeric code of a single character or a list of
character alternatives. For example to split on balanced
instances of \"[ \t]:\" set ALTS to '((32 9) . 58)."
- (flet ((matches (ch spec) (or (and (numberp spec) (= spec ch))
- (member ch spec)))
+ (flet ((matches (ch spec) (if (listp spec) (member ch spec) (equal spec ch)))
(matched (ch last)
(if (consp alts)
(and (matches ch (cdr alts))
(catch 'is-a-code-block
(when (re-search-forward
(concat org-babel-result-regexp
- "[ \t]" (regexp-quote name) "[ \t\n\f\v\r]") nil t)
+ "[ \t]" (regexp-quote name) "[ \t]*[\n\f\v\r]") nil t)
(when (and (string= "name" (downcase (match-string 1)))
- (or (looking-at org-babel-src-block-regexp)
+ (or (beginning-of-line 1)
+ (looking-at org-babel-src-block-regexp)
(looking-at org-babel-multi-line-header-regexp)))
(throw 'is-a-code-block (org-babel-find-named-result name (point))))
(beginning-of-line 0) (point)))))
(inlinep (when (org-babel-get-inline-src-block-matches)
(match-end 0)))
(name (if on-lob-line
- (nth 0 (org-babel-lob-get-info))
+ (mapconcat #'identity (butlast (org-babel-lob-get-info)) "")
(nth 4 (or info (org-babel-get-src-block-info 'light)))))
(head (unless on-lob-line (org-babel-where-is-src-block-head)))
found beg end)
(lambda (el) " ")
(org-number-sequence 1 indent) "")
"")
- "#+results"
+ "#+" org-babel-results-keyword
(when hash (concat "["hash"]"))
":"
(when name (concat " " name)) "\n"))
(setq results-switches
(if results-switches (concat " " results-switches) ""))
(flet ((wrap (start finish)
- (goto-char beg) (insert (concat start "\n"))
(goto-char end) (insert (concat finish "\n"))
+ (goto-char beg) (insert (concat start "\n"))
+ (goto-char end) (goto-char (point-at-eol))
(setq end (point-marker)))
(proper-list-p (it) (and (listp it) (null (cdr (last it))))))
;; insert results based on type
(prvs (org-list-prevs-alist struct)))
(org-list-get-list-end (point-at-bol) struct prvs)))
((looking-at "^\\([ \t]*\\):RESULTS:")
- (re-search-forward (concat "^" (match-string 1) ":END:")))
+ (progn (re-search-forward (concat "^" (match-string 1) ":END:"))
+ (forward-char 1) (point)))
(t
(let ((case-fold-search t)
(blocks-re (regexp-opt
(stringp (car result)) (stringp (cadr result)))
(format "[[file:%s][%s]]" (car result) (cadr result))))))
+(defvar org-babel-capitalize-examplize-region-markers nil
+ "Make true to capitalize begin/end example markers inserted by code blocks.")
+
(defun org-babel-examplize-region (beg end &optional results-switches)
"Comment out region using the inline '==' or ': ' org example quote."
(interactive "*r")
- (flet ((chars-between (b e) (string-match "[\\S]" (buffer-substring b e))))
+ (flet ((chars-between (b e)
+ (not (string-match "^[\\s]*$" (buffer-substring b e))))
+ (maybe-cap (str) (if org-babel-capitalize-examplize-region-markers
+ (upcase str) str)))
(if (or (chars-between (save-excursion (goto-char beg) (point-at-bol)) beg)
(chars-between end (save-excursion (goto-char end) (point-at-eol))))
(save-excursion
(t
(goto-char beg)
(insert (if results-switches
- (format "#+begin_example%s\n" results-switches)
- "#+begin_example\n"))
+ (format "%s%s\n"
+ (maybe-cap "#+begin_example")
+ results-switches)
+ (maybe-cap "#+begin_example\n")))
(if (markerp end) (goto-char end) (forward-char (- end beg)))
- (insert "#+end_example\n"))))))))
+ (insert (maybe-cap "#+end_example\n")))))))))
(defun org-babel-update-block-body (new-body)
"Update the body of the current code block to NEW-BODY."
(with-temp-buffer
(insert body) (goto-char (point-min))
(setq index (point))
- (while (and (re-search-forward "<<\\(.+?\\)>>" nil t))
+ (while (and (re-search-forward "<<\\([^ \t\n].+?[^ \t\n]\\|[^ \t\n]\\)>>"
+ nil t))
(save-match-data (setf source-name (match-string 1)))
(save-match-data (setq evaluate (string-match "\(.*\)" source-name)))
(save-match-data
(setq index (point))
(nb-add
(with-current-buffer parent-buffer
+ (save-restriction
+ (widen)
(mapconcat ;; interpose PREFIX between every line
#'identity
(split-string
(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))
+ (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)))
- (if comment
- ((lambda (cs)
- (concat (c-wrap (car cs)) "\n"
- body "\n" (c-wrap (cadr cs))))
- (org-babel-tangle-comment-links i))
- (setq expansion (concat expansion body)))))
+ (body (org-babel-expand-noweb-references i))
+ (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
+ "\n"))
+ (full (if comment
+ ((lambda (cs)
+ (concat (c-wrap (car cs)) "\n"
+ body "\n"
+ (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)))
- (if comment
- ((lambda (cs)
- (concat (c-wrap (car cs)) "\n"
- body "\n" (c-wrap (cadr cs))))
- (org-babel-tangle-comment-links i))
- (setq expansion (concat expansion body)))))))))
- expansion)
+ (let* ((body (org-babel-expand-noweb-references i))
+ (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
+ "\n"))
+ (full (if comment
+ ((lambda (cs)
+ (concat (c-wrap (car cs)) "\n"
+ body "\n"
+ (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
"could not be resolved (see "
"`org-babel-noweb-error-langs')"))
"")))
- "[\n\r]") (concat "\n" prefix)))))
+ "[\n\r]") (concat "\n" prefix))))))
(nb-add (buffer-substring index (point-max)))))
new-body))
(when text
(set-text-properties 0 (length text) nil text) text))
-(defun org-babel-strip-protective-commas (body)
+(defun org-babel-strip-protective-commas (body &optional lang)
"Strip protective commas from bodies of source blocks."
- (when body
- (replace-regexp-in-string "^,#" "#" body)))
+ (with-temp-buffer
+ (insert body)
+ (if (and lang (string= lang "org"))
+ (progn (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*\\(,\\)" nil t)
+ (replace-match "" nil nil nil 1)))
+ (org-strip-protective-commas (point-min) (point-max)))
+ (buffer-string)))
(defun org-babel-script-escape (str &optional force)
"Safely convert tables into elisp lists."