1
0
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-11-24 07:20:29 +00:00

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 2012-08-19 22:07:55 +02:00
parent e0da410066
commit 3dce21a0a4
2 changed files with 116 additions and 128 deletions

View File

@ -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.

View File

@ -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))))
;;================================================================================