From 3dce21a0a4464463e1a518ae5b6ca5aef0dbc3c8 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 19 Aug 2012 22:07:55 +0200 Subject: [PATCH] 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. --- lisp/ob-exp.el | 127 +++++++++++++++++++++++++------------------------ lisp/org-exp-blocks.el | 117 ++++++++++++++++++++------------------------- 2 files changed, 116 insertions(+), 128 deletions(-) diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el index d17fd3475..d1b2e3536 100644 --- a/lisp/ob-exp.el +++ b/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. diff --git a/lisp/org-exp-blocks.el b/lisp/org-exp-blocks.el index 89a0e5e55..2fe135d3b 100644 --- a/lisp/org-exp-blocks.el +++ b/lisp/org-exp-blocks.el @@ -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)))) ;;================================================================================ -- 2.11.4.GIT