X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e66ba1dfc4cf2e12100191d2c24436c42d097268..ef62b23df5a7007c3d8c74dbca87ba83e9da682e:/lisp/org/ob.el diff --git a/lisp/org/ob.el b/lisp/org/ob.el index 3eee92a906..0512248758 100644 --- a/lisp/org/ob.el +++ b/lisp/org/ob.el @@ -1,8 +1,8 @@ ;;; 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 @@ -79,6 +79,7 @@ (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." @@ -104,6 +105,7 @@ against accidental code block evaluation. The `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))) @@ -111,8 +113,16 @@ remove code block execution from the C-c C-c keybinding." (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.") @@ -169,8 +179,8 @@ Returns non-nil if match-data set" (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)))) @@ -376,6 +386,7 @@ then run `org-babel-pop-to-session'." (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) @@ -469,7 +480,10 @@ the header arguments specified at the front of the source code 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 @@ -597,15 +611,17 @@ arguments and pop open the results in a preview buffer." ;; 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."))) @@ -884,6 +900,31 @@ buffer." (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. @@ -892,12 +933,10 @@ the current 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) @@ -999,6 +1038,89 @@ This can be called with C-c C-c." (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. @@ -1037,12 +1159,13 @@ may be specified in the properties of the current outline entry." (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 @@ -1060,7 +1183,7 @@ may be specified in the properties of the current outline entry." (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) @@ -1074,8 +1197,7 @@ ALTS is a cons of two character options where each option may be 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)) @@ -1377,9 +1499,10 @@ buffer or nil if no such result exists." (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))))) @@ -1492,7 +1615,7 @@ following the source block." (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) @@ -1545,7 +1668,7 @@ following the source block." (lambda (el) " ") (org-number-sequence 1 indent) "") "") - "#+results" + "#+" org-babel-results-keyword (when hash (concat "["hash"]")) ":" (when name (concat " " name)) "\n")) @@ -1716,8 +1839,9 @@ code ---- the results are extracted in the syntax of the source (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 @@ -1803,7 +1927,8 @@ code ---- the results are extracted in the syntax of the source (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 @@ -1833,10 +1958,16 @@ file's directory then expand relative links." (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 @@ -1853,10 +1984,12 @@ file's directory then expand relative links." (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." @@ -2032,7 +2165,8 @@ block but are passed literally to the \"example-block\"." (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 @@ -2047,6 +2181,8 @@ block but are passed literally to the \"example-block\"." (setq index (point)) (nb-add (with-current-buffer parent-buffer + (save-restriction + (widen) (mapconcat ;; interpose PREFIX between every line #'identity (split-string @@ -2062,33 +2198,43 @@ block but are passed literally to the \"example-block\"." (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 @@ -2096,7 +2242,7 @@ block but are passed literally to the \"example-block\"." "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)) @@ -2105,10 +2251,16 @@ block but are passed literally to the \"example-block\"." (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."