mirrors
/
org-mode
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git
0
0
Fork 1
Code Releases Activity

org-exp-blocks: Ensure balanced nested begin/end blocks in block bodies. 

* lisp/org-exp-blocks.el (org-export-blocks-preprocess): Ensure
  balanced nested begin/end blocks in block bodies.
This commit is contained in:
Eric Schulte 2011-06-13 14:04:24 -07:00
parent c4737ae48b
commit 5d7e0b79c9
1 changed files with 41 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
lisp/org-exp-blocks.el
View File

@ -76,13 +76,6 @@
(require 'cl))
(require 'org)
(defvar org-exp-blocks-block-regexp
(concat
"^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)"
"[ \t]*\\(.*\\)?[\r\n]\\([^\000]*?\\)[\r\n]*[ \t]*"
"#\\+end_\\S-+.*[\r\n]?")
"Regular expression used to match blocks by org-exp-blocks.")
(defun org-export-blocks-set (var value)
"Set the value of `org-export-blocks' and install fontification."
(set var value)
@ -175,32 +168,52 @@ which defaults to the value of `org-export-blocks-witheld'."
(save-window-excursion
(let ((case-fold-search t)
(types '())
indentation type func start body headers preserve-indent progress-marker)
matched indentation type func
start end body headers preserve-indent progress-marker)
(flet ((interblock (start end)
(mapcar (lambda (pair) (funcall (second pair) start end))
org-export-interblocks)))
(goto-char (point-min))
(setq start (point))
(while (re-search-forward org-exp-blocks-block-regexp nil t)
(setq indentation (length (match-string 1)))
(setq type (intern (downcase (match-string 2))))
(setq headers (save-match-data (org-split-string (match-string 3) "[ \t]+")))
(setq body (match-string 4))
(setq preserve-indent (or org-src-preserve-indentation (member "-i" headers)))
(unless preserve-indent
(setq body (save-match-data (org-remove-indentation body))))
(unless (memq type types) (setq types (cons type types)))
(save-match-data (interblock start (match-beginning 0)))
(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)))))
(when replacement
(replace-match replacement t t)
(unless preserve-indent
(indent-code-rigidly
(match-beginning 0) (match-end 0) indentation)))))
(setq start (match-end 0)))
(let ((beg-re "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]"))
(while (re-search-forward beg-re nil t)
(let* ((match-start (match-beginning 0))
(body-start (match-end 0))
(indentation (length (match-string 1)))
(inner-re (format "[\r\n]*[ \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 (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 (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)))))
(when replacement
(delete-region match-start match-end)
(goto-char match-start) (insert replacement)
(unless preserve-indent
(indent-code-rigidly match-start (point) indentation))))))
(setq start (point))))
(interblock start (point-max))
(run-hooks 'org-export-blocks-postblock-hook)))))