diff options
Diffstat (limited to 'lisp/org/ob.el')
| -rw-r--r-- | lisp/org/ob.el | 199 |
1 files changed, 169 insertions, 30 deletions
diff --git a/lisp/org/ob.el b/lisp/org/ob.el index 0288eb357b5..04c011c867d 100644 --- a/lisp/org/ob.el +++ b/lisp/org/ob.el @@ -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." @@ -113,6 +114,13 @@ remove code block execution from the C-c C-c keybinding." :group 'org-babel :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 +177,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 +384,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 +478,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 +609,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."))) @@ -885,6 +899,31 @@ buffer." (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. Call `org-babel-execute-src-block' on every source block in @@ -892,12 +931,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 +1036,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. @@ -1042,7 +1162,7 @@ may be specified in the properties of the current outline entry." ;; 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 +1180,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) @@ -1376,9 +1496,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))))) @@ -1491,7 +1612,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) @@ -1544,7 +1665,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")) @@ -1715,8 +1836,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 @@ -1802,7 +1924,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 @@ -1835,7 +1958,8 @@ file's directory then expand relative links." (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))))) (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 @@ -2031,7 +2155,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 @@ -2046,6 +2171,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 @@ -2061,7 +2188,7 @@ 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)) @@ -2069,6 +2196,8 @@ block but are passed literally to the \"example-block\"." (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 (c-wrap (car cs)) "\n" @@ -2076,13 +2205,15 @@ block but are passed literally to the \"example-block\"." (c-wrap (cadr cs)))) (org-babel-tangle-comment-links i)) body))) - (setq expansion (concat expansion full)))) + (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 (c-wrap (car cs)) "\n" @@ -2090,8 +2221,10 @@ block but are passed literally to the \"example-block\"." (c-wrap (cadr cs)))) (org-babel-tangle-comment-links i)) body))) - (setq expansion (concat expansion full)))))))) - expansion) + (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 @@ -2099,7 +2232,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)) @@ -2108,10 +2241,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." |