forked from mirrors/org-mode
Rewrite Babel pre-processing functions
* lisp/ob-exp.el (org-babel-exp-src-block): Remove unused argument. (org-babel-exp-non-block-elements): Rewrite function using Org Element. * lisp/org-exp-blocks.el (org-export-blocks-preprocess): Rewrite function using Org Element.
This commit is contained in:
Nicolas Goaziou
parent
e0da410066
commit
3dce21a0a4
127
lisp/ob-exp.el
127
lisp/ob-exp.el
|
|
@ -87,7 +87,7 @@ process."
|
|||
results)))
|
||||
(def-edebug-spec org-babel-exp-in-export-file (form body))
|
||||
|
||||
(defun org-babel-exp-src-block (body &rest headers)
|
||||
(defun org-babel-exp-src-block (&rest headers)
|
||||
"Process source block for export.
|
||||
Depending on the 'export' headers argument in replace the source
|
||||
code block with...
|
||||
|
|
@ -100,11 +100,12 @@ code ---- the default, display the code inside the block but do
|
|||
results - just like none only the block is run on export ensuring
|
||||
that it's results are present in the org-mode buffer
|
||||
|
||||
none ----- do not display either code or results upon export"
|
||||
none ----- do not display either code or results upon export
|
||||
|
||||
Assume point is at the beginning of block's starting line."
|
||||
(interactive)
|
||||
(unless noninteractive (message "org-babel-exp processing..."))
|
||||
(save-excursion
|
||||
(goto-char (match-beginning 0))
|
||||
(let* ((info (org-babel-get-src-block-info 'light))
|
||||
(lang (nth 0 info))
|
||||
(raw-params (nth 2 info)) hash)
|
||||
|
|
@ -150,66 +151,68 @@ this template."
|
|||
(let ((m (make-marker)))
|
||||
(set-marker m end (current-buffer))
|
||||
(setq end m)))
|
||||
(let ((rx (concat "\\(" org-babel-inline-src-block-regexp
|
||||
(let ((rx (concat "\\(?:" org-babel-inline-src-block-regexp
|
||||
"\\|" org-babel-lob-one-liner-regexp "\\)")))
|
||||
(while (and (< (point) (marker-position end))
|
||||
(re-search-forward rx end t))
|
||||
(if (save-excursion
|
||||
(goto-char (match-beginning 0))
|
||||
(looking-at org-babel-inline-src-block-regexp))
|
||||
(progn
|
||||
(forward-char 1)
|
||||
(let* ((info (save-match-data
|
||||
(org-babel-parse-inline-src-block-match)))
|
||||
(params (nth 2 info)))
|
||||
(save-match-data
|
||||
(goto-char (match-beginning 2))
|
||||
(unless (org-babel-in-example-or-verbatim)
|
||||
;; expand noweb references in the original file
|
||||
(setf (nth 1 info)
|
||||
(if (and (cdr (assoc :noweb params))
|
||||
(string= "yes" (cdr (assoc :noweb params))))
|
||||
(org-babel-expand-noweb-references
|
||||
info (org-babel-exp-get-export-buffer))
|
||||
(nth 1 info)))
|
||||
(let ((code-replacement (save-match-data
|
||||
(org-babel-exp-do-export
|
||||
info 'inline))))
|
||||
(if code-replacement
|
||||
(progn (replace-match code-replacement nil nil nil 1)
|
||||
(delete-char 1))
|
||||
(org-babel-examplize-region (match-beginning 1)
|
||||
(match-end 1))
|
||||
(forward-char 2)))))))
|
||||
(unless (org-babel-in-example-or-verbatim)
|
||||
(let* ((lob-info (org-babel-lob-get-info))
|
||||
(inlinep (match-string 11))
|
||||
(inline-start (match-end 11))
|
||||
(inline-end (match-end 0))
|
||||
(results (save-match-data
|
||||
(org-babel-exp-do-export
|
||||
(list "emacs-lisp" "results"
|
||||
(org-babel-merge-params
|
||||
org-babel-default-header-args
|
||||
org-babel-default-lob-header-args
|
||||
(org-babel-params-from-properties)
|
||||
(org-babel-parse-header-arguments
|
||||
(org-no-properties
|
||||
(concat ":var results="
|
||||
(mapconcat #'identity
|
||||
(butlast lob-info)
|
||||
" ")))))
|
||||
"" nil (car (last lob-info)))
|
||||
'lob)))
|
||||
(rep (org-fill-template
|
||||
org-babel-exp-call-line-template
|
||||
`(("line" . ,(nth 0 lob-info))))))
|
||||
(if inlinep
|
||||
(save-excursion
|
||||
(goto-char inline-start)
|
||||
(delete-region inline-start inline-end)
|
||||
(insert rep))
|
||||
(replace-match rep t t)))))))))
|
||||
(while (re-search-forward rx end t)
|
||||
(let* ((element (save-match-data (org-element-context)))
|
||||
(type (org-element-type element)))
|
||||
(cond
|
||||
((not (memq type '(babel-call inline-babel-call inline-src-block))))
|
||||
((eq type 'inline-src-block)
|
||||
(let* ((beg (org-element-property :begin element))
|
||||
(end (save-excursion
|
||||
(goto-char (org-element-property :end element))
|
||||
(skip-chars-forward " \t")
|
||||
(point)))
|
||||
(info (org-babel-parse-inline-src-block-match))
|
||||
(params (nth 2 info)))
|
||||
;; Expand noweb references in the original file.
|
||||
(setf (nth 1 info)
|
||||
(if (and (cdr (assoc :noweb params))
|
||||
(string= "yes" (cdr (assoc :noweb params))))
|
||||
(org-babel-expand-noweb-references
|
||||
info (org-babel-exp-get-export-buffer))
|
||||
(nth 1 info)))
|
||||
(let ((code-replacement
|
||||
(save-match-data (org-babel-exp-do-export info 'inline))))
|
||||
(if code-replacement
|
||||
(progn
|
||||
(delete-region
|
||||
(progn (goto-char beg)
|
||||
(skip-chars-backward " \t")
|
||||
(point))
|
||||
end)
|
||||
(insert code-replacement))
|
||||
(org-babel-examplize-region beg end)
|
||||
(forward-char 2)))))
|
||||
(t (let* ((lob-info (org-babel-lob-get-info))
|
||||
(inlinep (match-string 11))
|
||||
(inline-start (match-end 11))
|
||||
(inline-end (match-end 0))
|
||||
(results (save-match-data
|
||||
(org-babel-exp-do-export
|
||||
(list "emacs-lisp" "results"
|
||||
(org-babel-merge-params
|
||||
org-babel-default-header-args
|
||||
org-babel-default-lob-header-args
|
||||
(org-babel-params-from-properties)
|
||||
(org-babel-parse-header-arguments
|
||||
(org-no-properties
|
||||
(concat ":var results="
|
||||
(mapconcat #'identity
|
||||
(butlast lob-info)
|
||||
" ")))))
|
||||
"" nil (car (last lob-info)))
|
||||
'lob)))
|
||||
(rep (org-fill-template
|
||||
org-babel-exp-call-line-template
|
||||
`(("line" . ,(nth 0 lob-info))))))
|
||||
(if inlinep
|
||||
(save-excursion
|
||||
(goto-char inline-start)
|
||||
(delete-region inline-start inline-end)
|
||||
(insert rep))
|
||||
(replace-match rep t t))))))))))
|
||||
|
||||
(defun org-babel-in-example-or-verbatim ()
|
||||
"Return true if point is in example or verbatim code.
|
||||
|
|
|
|||
|
|
@ -166,75 +166,60 @@ The optional OPEN and CLOSE tags will be inserted around BODY."
|
|||
|
||||
(defvar org-src-preserve-indentation) ; From org-src.el
|
||||
(defun org-export-blocks-preprocess ()
|
||||
"Export all blocks according to the `org-export-blocks' block export alist.
|
||||
Does not export block types specified in specified in BLOCKS
|
||||
which defaults to the value of `org-export-blocks-witheld'."
|
||||
"Execute all blocks in visible part of buffer."
|
||||
(interactive)
|
||||
(save-window-excursion
|
||||
(let ((case-fold-search t)
|
||||
(interblock (lambda (start end)
|
||||
(mapcar (lambda (pair) (funcall (second pair) start end))
|
||||
org-export-interblocks)))
|
||||
matched indentation type types func
|
||||
start end body headers preserve-indent progress-marker)
|
||||
(goto-char (point-min))
|
||||
(setq start (point))
|
||||
(let ((beg-re "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]"))
|
||||
(while (re-search-forward beg-re nil t)
|
||||
(let* ((match-start (copy-marker (match-beginning 0)))
|
||||
(body-start (copy-marker (match-end 0)))
|
||||
(indentation (length (match-string 1)))
|
||||
(inner-re (format "^[ \t]*#\\+\\(begin\\|end\\)_%s"
|
||||
(regexp-quote (downcase (match-string 2)))))
|
||||
(type (intern (downcase (match-string 2))))
|
||||
(headers (save-match-data
|
||||
(org-split-string (match-string 3) "[ \t]+")))
|
||||
(balanced 1)
|
||||
(preserve-indent (or org-src-preserve-indentation
|
||||
(member "-i" headers)))
|
||||
match-end)
|
||||
(while (and (not (zerop balanced))
|
||||
(re-search-forward inner-re nil t))
|
||||
(if (string= (downcase (match-string 1)) "end")
|
||||
(decf balanced)
|
||||
(incf balanced)))
|
||||
(when (not (zerop balanced))
|
||||
(error "Unbalanced begin/end_%s blocks with %S"
|
||||
type (buffer-substring match-start (point))))
|
||||
(setq match-end (copy-marker (match-end 0)))
|
||||
(unless preserve-indent
|
||||
(setq body (save-match-data (org-remove-indentation
|
||||
(buffer-substring
|
||||
body-start (match-beginning 0))))))
|
||||
(unless (memq type types) (setq types (cons type types)))
|
||||
(save-match-data (funcall interblock start match-start))
|
||||
(when (setq func (cadr (assoc type org-export-blocks)))
|
||||
(let ((replacement (save-match-data
|
||||
(if (memq type org-export-blocks-witheld) ""
|
||||
(apply func body headers)))))
|
||||
;; ;; un-comment this code after the org-element merge
|
||||
;; (save-match-data
|
||||
;; (when (and replacement (string= replacement ""))
|
||||
;; (delete-region
|
||||
;; (car (org-element-collect-affiliated-keyword))
|
||||
;; match-start)))
|
||||
(when replacement
|
||||
(delete-region match-start match-end)
|
||||
(goto-char match-start) (insert replacement)
|
||||
(if preserve-indent
|
||||
;; indent only the code block markers
|
||||
(save-excursion
|
||||
(indent-line-to indentation) ; indent end_block
|
||||
(goto-char match-start)
|
||||
(indent-line-to indentation)) ; indent begin_block
|
||||
;; indent everything
|
||||
(indent-code-rigidly match-start (point) indentation)))))
|
||||
;; cleanup markers
|
||||
(set-marker match-start nil)
|
||||
(set-marker body-start nil)
|
||||
(set-marker match-end nil))
|
||||
(setq start (point))))
|
||||
(funcall interblock start (point-max))
|
||||
(start (point-min)))
|
||||
(goto-char start)
|
||||
(while (re-search-forward "^[ \t]*#\\+BEGIN_SRC" nil t)
|
||||
(let ((element (save-match-data (org-element-at-point))))
|
||||
(when (eq (org-element-type element) 'src-block)
|
||||
(let* ((block-start (copy-marker (match-beginning 0)))
|
||||
(match-start (copy-marker
|
||||
(org-element-property :begin element)))
|
||||
;; Make sure we don't remove any blank lines after
|
||||
;; the block when replacing it.
|
||||
(match-end (save-excursion
|
||||
(goto-char (org-element-property :end element))
|
||||
(skip-chars-backward " \r\t\n")
|
||||
(copy-marker (line-end-position))))
|
||||
(indentation (org-get-indentation))
|
||||
(headers
|
||||
(cons
|
||||
(org-element-property :language element)
|
||||
(let ((params (org-element-property :parameters element)))
|
||||
(and params (org-split-string params "[ \t]+")))))
|
||||
(preserve-indent (or org-src-preserve-indentation
|
||||
(org-element-property :preserve-indent
|
||||
element))))
|
||||
;; Execute all non-block elements between START and
|
||||
;; MATCH-START.
|
||||
(org-babel-exp-non-block-elements start match-start)
|
||||
(let ((replacement
|
||||
(progn (goto-char block-start)
|
||||
(org-babel-exp-src-block headers))))
|
||||
(when replacement
|
||||
(goto-char match-start)
|
||||
(delete-region (point) match-end)
|
||||
(insert replacement)
|
||||
(if preserve-indent
|
||||
;; Indent only the code block markers.
|
||||
(save-excursion
|
||||
(skip-chars-backward " \r\t\n")
|
||||
(indent-line-to indentation)
|
||||
(goto-char match-start)
|
||||
(indent-line-to indentation))
|
||||
;; Indent everything.
|
||||
(indent-code-rigidly match-start (point) indentation))))
|
||||
;; Cleanup markers.
|
||||
(set-marker block-start nil)
|
||||
(set-marker match-start nil)
|
||||
(set-marker match-end nil))))
|
||||
(setq start (point)))
|
||||
;; Execute all non-block Babel elements between last src-block
|
||||
;; and end of buffer.
|
||||
(org-babel-exp-non-block-elements start (point-max))
|
||||
(run-hooks 'org-export-blocks-postblock-hook))))
|
||||
|
||||
;;================================================================================
|
||||
|
|
|
|||
Loading…
Reference in a new issue