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.

1 files changed, 41 insertions, 28 deletions

diff --git a/lisp/org-exp-blocks.el b/lisp/org-exp-blocks.el
index bc8d289..4fd9450 100644
--- a/lisp/org-exp-blocks.el
+++ b/lisp/org-exp-blocks.el
@@ -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)))))