Jelajahi Sumber

org-babel-exp-process-buffer: Improve performance

* lisp/ob-exp.el (org-babel-exp-src-block): New optional argument
providing ELEMENT at point.
(org-babel-exp-code-template): Use lower-case #+begin/#+end lines to
avoid triggering source code block changes when the blocks are
exported with :exports code and also contain lower-case
 #+begin/#+end.  We prefer lower-case default because other parts of
 Org, like `org-insert-structure-template' default to lower-case as
 well.
(org-babel-exp-process-buffer): Do no disable cache as changes are not
expected to be as frequent anymore.  Pass pre-calculated element at
point to inner function calls to `org-in-commented-heading-p',
`org-in-archived-heading-p', `org-element-context', and
`org-babel-exp-src-block'.  Do not force-replace source block contents
when no change is required.
* testing/lisp/test-ob-exp.el (ob-export/export-with-results-before-block):
(ob-export/body-with-coderef):
(ob-exp/src-block-with-affiliated-keyword): Update tests according to
the new `org-babel-exp-code-template'.
Ihor Radchenko 2 tahun lalu
induk
melakukan
3bbbf77f36
2 mengubah file dengan 170 tambahan dan 140 penghapusan
  1. 165 135
      lisp/ob-exp.el
  2. 5 5
      testing/lisp/test-ob-exp.el

+ 165 - 135
lisp/ob-exp.el

@@ -66,7 +66,7 @@ point is at the beginning of the Babel block."
 	(when source (goto-char source))
 	(when source (goto-char source))
 	,@body))))
 	,@body))))
 
 
-(defun org-babel-exp-src-block ()
+(defun org-babel-exp-src-block (&optional element)
   "Process source block for export.
   "Process source block for export.
 Depending on the \":export\" header argument, replace the source
 Depending on the \":export\" header argument, replace the source
 code block like this:
 code block like this:
@@ -81,10 +81,12 @@ results - just like none only the block is run on export ensuring
 
 
 none ---- do not display either code or results upon export
 none ---- do not display either code or results upon export
 
 
+Optional argument ELEMENT must contain source block element at point.
+
 Assume point is at block opening line."
 Assume point is at block opening line."
   (interactive)
   (interactive)
   (save-excursion
   (save-excursion
-    (let* ((info (org-babel-get-src-block-info))
+    (let* ((info (org-babel-get-src-block-info nil element))
 	   (lang (nth 0 info))
 	   (lang (nth 0 info))
 	   (raw-params (nth 2 info))
 	   (raw-params (nth 2 info))
 	   hash)
 	   hash)
@@ -137,7 +139,8 @@ this template."
 	    ;; Get a pristine copy of current buffer so Babel
 	    ;; Get a pristine copy of current buffer so Babel
 	    ;; references are properly resolved and source block
 	    ;; references are properly resolved and source block
 	    ;; context is preserved.
 	    ;; context is preserved.
-	    (org-babel-exp-reference-buffer (org-export-copy-buffer)))
+	    (org-babel-exp-reference-buffer (org-export-copy-buffer))
+            element)
 	(unwind-protect
 	(unwind-protect
 	    (save-excursion
 	    (save-excursion
 	      ;; First attach to every source block their original
 	      ;; First attach to every source block their original
@@ -158,139 +161,166 @@ this template."
 	      ;; encountered.
 	      ;; encountered.
 	      (goto-char (point-min))
 	      (goto-char (point-min))
               ;; We are about to do a large number of changes in
               ;; We are about to do a large number of changes in
-              ;; buffer.  Do not try to track them in cache and update
-              ;; the folding states.  Reset the cache afterwards.
-              (org-element-with-disabled-cache
-                (org-fold-core-ignore-modifications
-	          (while (re-search-forward regexp nil t)
-		    (unless (save-match-data (or (org-in-commented-heading-p)
-					         (org-in-archived-heading-p)))
-		      (let* ((object? (match-end 1))
-			     (element (save-match-data
-				        (if object? (org-element-context)
-				          ;; No deep inspection if we're
-				          ;; just looking for an element.
-				          (org-element-at-point))))
-			     (type
-			      (pcase (org-element-type element)
-			        ;; Discard block elements if we're looking
-			        ;; for inline objects.  False results
-			        ;; happen when, e.g., "call_" syntax is
-			        ;; located within affiliated keywords:
-			        ;;
-			        ;; #+name: call_src
-			        ;; #+begin_src ...
-			        ((and (or `babel-call `src-block) (guard object?))
-			         nil)
-			        (type type)))
-			     (begin
-			      (copy-marker (org-element-property :begin element)))
-			     (end
-			      (copy-marker
-			       (save-excursion
-			         (goto-char (org-element-property :end element))
-			         (skip-chars-backward " \r\t\n")
-			         (point)))))
-		        (pcase type
-		          (`inline-src-block
-		           (let* ((info
-			           (org-babel-get-src-block-info nil element))
-			          (params (nth 2 info)))
-			     (setf (nth 1 info)
-			           (if (and (cdr (assq :noweb params))
-					    (string= "yes"
-						     (cdr (assq :noweb params))))
-				       (org-babel-expand-noweb-references
-				        info org-babel-exp-reference-buffer)
-				     (nth 1 info)))
-			     (goto-char begin)
-			     (let ((replacement
-				    (org-babel-exp-do-export info 'inline)))
-			       (if (equal replacement "")
-			           ;; Replacement code is empty: remove
-			           ;; inline source block, including extra
-			           ;; white space that might have been
-			           ;; created when inserting results.
-			           (delete-region begin
-					          (progn (goto-char end)
-						         (skip-chars-forward " \t")
-						         (point)))
-			         ;; Otherwise: remove inline source block
-			         ;; but preserve following white spaces.
-			         ;; Then insert value.
+              ;; buffer, but we do not care about folding in this
+              ;; buffer.
+              (org-fold-core-ignore-modifications
+	        (while (re-search-forward regexp nil t)
+                  (setq element (org-element-at-point))
+		  (unless (save-match-data
+                            (or (org-in-commented-heading-p nil element)
+				(org-in-archived-heading-p nil element)))
+		    (let* ((object? (match-end 1))
+			   (element (save-match-data
+				      (if object?
+                                          (org-element-context element)
+				        ;; No deep inspection if we're
+				        ;; just looking for an element.
+                                        element)))
+			   (type
+			    (pcase (org-element-type element)
+			      ;; Discard block elements if we're looking
+			      ;; for inline objects.  False results
+			      ;; happen when, e.g., "call_" syntax is
+			      ;; located within affiliated keywords:
+			      ;;
+			      ;; #+name: call_src
+			      ;; #+begin_src ...
+			      ((and (or `babel-call `src-block) (guard object?))
+			       nil)
+			      (type type)))
+			   (begin
+			    (copy-marker (org-element-property :begin element)))
+			   (end
+			    (copy-marker
+			     (save-excursion
+			       (goto-char (org-element-property :end element))
+			       (skip-chars-backward " \r\t\n")
+			       (point)))))
+		      (pcase type
+		        (`inline-src-block
+		         (let* ((info
+			         (org-babel-get-src-block-info nil element))
+			        (params (nth 2 info)))
+			   (setf (nth 1 info)
+			         (if (and (cdr (assq :noweb params))
+					  (string= "yes"
+						   (cdr (assq :noweb params))))
+				     (org-babel-expand-noweb-references
+				      info org-babel-exp-reference-buffer)
+				   (nth 1 info)))
+			   (goto-char begin)
+			   (let ((replacement
+				  (org-babel-exp-do-export info 'inline)))
+			     (if (equal replacement "")
+			         ;; Replacement code is empty: remove
+			         ;; inline source block, including extra
+			         ;; white space that might have been
+			         ;; created when inserting results.
+			         (delete-region begin
+					        (progn (goto-char end)
+						       (skip-chars-forward " \t")
+						       (point)))
+			       ;; Otherwise: remove inline source block
+			       ;; but preserve following white spaces.
+			       ;; Then insert value.
+                               (unless (string= replacement
+                                                (buffer-substring begin end))
 			         (delete-region begin end)
 			         (delete-region begin end)
-			         (insert replacement)))))
-		          ((or `babel-call `inline-babel-call)
-                           (org-babel-exp-do-export
-                            (or (org-babel-lob-get-info element)
-                                (user-error "Unknown Babel reference: %s"
-                                            (org-element-property :call element)))
-                            'lob)
-		           (let ((rep
-			          (org-fill-template
-			           org-babel-exp-call-line-template
-			           `(("line"  .
-				      ,(org-element-property :value element))))))
-			     ;; If replacement is empty, completely remove
-			     ;; the object/element, including any extra
-			     ;; white space that might have been created
-			     ;; when including results.
-			     (if (equal rep "")
-			         (delete-region
-			          begin
-			          (progn (goto-char end)
-				         (if (not (eq type 'babel-call))
-					     (progn (skip-chars-forward " \t")
-						    (point))
-				           (skip-chars-forward " \r\t\n")
-				           (line-beginning-position))))
-			       ;; Otherwise, preserve trailing
-			       ;; spaces/newlines and then, insert
-			       ;; replacement string.
-			       (goto-char begin)
-			       (delete-region begin end)
-			       (insert rep))))
-		          (`src-block
-		           (let ((match-start (copy-marker (match-beginning 0)))
-			         (ind (current-indentation)))
-			     ;; Take care of matched block: compute
-			     ;; replacement string.  In particular, a nil
-			     ;; REPLACEMENT means the block is left as-is
-			     ;; while an empty string removes the block.
-			     (let ((replacement
-				    (progn (goto-char match-start)
-				           (org-babel-exp-src-block))))
-			       (cond ((not replacement) (goto-char end))
-				     ((equal replacement "")
-				      (goto-char end)
-				      (skip-chars-forward " \r\t\n")
-				      (beginning-of-line)
-				      (delete-region begin (point)))
-				     (t
-				      (goto-char match-start)
-				      (delete-region (point)
-						     (save-excursion
-						       (goto-char end)
-						       (line-end-position)))
-				      (insert replacement)
-				      (if (or org-src-preserve-indentation
-					      (org-element-property
-					       :preserve-indent element))
-				          ;; Indent only code block
-				          ;; markers.
-				          (save-excursion
-					    (skip-chars-backward " \r\t\n")
-					    (indent-line-to ind)
-					    (goto-char match-start)
-					    (indent-line-to ind))
-				        ;; Indent everything.
+			         (insert replacement))))))
+		        ((or `babel-call `inline-babel-call)
+                         (org-babel-exp-do-export
+                          (or (org-babel-lob-get-info element)
+                              (user-error "Unknown Babel reference: %s"
+                                          (org-element-property :call element)))
+                          'lob)
+		         (let ((rep
+			        (org-fill-template
+			         org-babel-exp-call-line-template
+			         `(("line"  .
+				    ,(org-element-property :value element))))))
+			   ;; If replacement is empty, completely remove
+			   ;; the object/element, including any extra
+			   ;; white space that might have been created
+			   ;; when including results.
+			   (if (equal rep "")
+			       (delete-region
+			        begin
+			        (progn (goto-char end)
+				       (if (not (eq type 'babel-call))
+					   (progn (skip-chars-forward " \t")
+						  (point))
+				         (skip-chars-forward " \r\t\n")
+				         (line-beginning-position))))
+			     ;; Otherwise, preserve trailing
+			     ;; spaces/newlines and then, insert
+			     ;; replacement string.
+			     (goto-char begin)
+			     (delete-region begin end)
+			     (insert rep))))
+		        (`src-block
+		         (let ((match-start (copy-marker (match-beginning 0)))
+			       (ind (current-indentation)))
+			   ;; Take care of matched block: compute
+			   ;; replacement string.  In particular, a nil
+			   ;; REPLACEMENT means the block is left as-is
+			   ;; while an empty string removes the block.
+			   (let ((replacement
+				  (progn (goto-char match-start)
+				         (org-babel-exp-src-block element))))
+			     (cond ((not replacement) (goto-char end))
+				   ((equal replacement "")
+				    (goto-char end)
+				    (skip-chars-forward " \r\t\n")
+				    (beginning-of-line)
+				    (delete-region begin (point)))
+				   (t
+				    (if (or org-src-preserve-indentation
+					    (org-element-property
+					     :preserve-indent element))
+				        ;; Indent only code block
+				        ;; markers.
+				        (with-temp-buffer
+                                          ;; Do not use tabs for block
+                                          ;; indentation.
+                                          (when (fboundp 'indent-tabs-mode)
+                                            (indent-tabs-mode -1)
+                                            ;; FIXME: Emacs 26
+                                            ;; compatibility.
+                                            (setq-local indent-tabs-mode nil))
+                                          (insert replacement)
+					  (skip-chars-backward " \r\t\n")
+					  (indent-line-to ind)
+					  (goto-char 1)
+					  (indent-line-to ind)
+                                          (setq replacement (buffer-string)))
+				      ;; Indent everything.
+                                      (with-temp-buffer
+                                        ;; Do not use tabs for block
+                                        ;; indentation.
+                                        (when (fboundp 'indent-tabs-mode)
+                                          (indent-tabs-mode -1)
+                                          ;; FIXME: Emacs 26
+                                          ;; compatibility.
+                                          (setq-local indent-tabs-mode nil))
+                                        (insert replacement)
 				        (indent-rigidly
 				        (indent-rigidly
-				         match-start (point) ind)))))
-			     (set-marker match-start nil))))
-		        (set-marker begin nil)
-		        (set-marker end nil))))))
-              ;; Reset the outdated cache.
-              (org-element-cache-reset))
+				         1 (point) ind)
+                                        (setq replacement (buffer-string))))
+				    (goto-char match-start)
+                                    (let ((rend (save-excursion
+						  (goto-char end)
+						  (line-end-position))))
+                                      (if (string-equal replacement
+                                                        (buffer-substring match-start rend))
+                                          (goto-char rend)
+				        (delete-region match-start
+					               (save-excursion
+					                 (goto-char end)
+					                 (line-end-position)))
+				        (insert replacement))))))
+			   (set-marker match-start nil))))
+		      (set-marker begin nil)
+		      (set-marker end nil))))))
 	  (kill-buffer org-babel-exp-reference-buffer)
 	  (kill-buffer org-babel-exp-reference-buffer)
           (remove-text-properties (point-min) (point-max)
           (remove-text-properties (point-min) (point-max)
                                   '(org-reference nil)))))))
                                   '(org-reference nil)))))))
@@ -313,7 +343,7 @@ The function respects the value of the :exports header argument."
        (org-babel-exp-code info type)))))
        (org-babel-exp-code info type)))))
 
 
 (defcustom org-babel-exp-code-template
 (defcustom org-babel-exp-code-template
-  "#+BEGIN_SRC %lang%switches%flags\n%body\n#+END_SRC"
+  "#+begin_src %lang%switches%flags\n%body\n#+end_src"
   "Template used to export the body of code blocks.
   "Template used to export the body of code blocks.
 This template may be customized to include additional information
 This template may be customized to include additional information
 such as the code block name, or the values of particular header
 such as the code block name, or the values of particular header

+ 5 - 5
testing/lisp/test-ob-exp.el

@@ -398,9 +398,9 @@ be evaluated."
 : 2
 : 2
 
 
 #+NAME: src1
 #+NAME: src1
-#+BEGIN_SRC emacs-lisp
+#+begin_src emacs-lisp
 \(+ 1 1)
 \(+ 1 1)
-#+END_SRC"
+#+end_src"
       (org-test-with-temp-text
       (org-test-with-temp-text
 	  "#+RESULTS: src1
 	  "#+RESULTS: src1
 
 
@@ -565,7 +565,7 @@ src_emacs-lisp{(+ 1 1)}"
 (ert-deftest ob-export/body-with-coderef ()
 (ert-deftest ob-export/body-with-coderef ()
   "Test exporting a code block with coderefs."
   "Test exporting a code block with coderefs."
   (should
   (should
-   (equal "#+BEGIN_SRC emacs-lisp\n0 (ref:foo)\n#+END_SRC"
+   (equal "#+begin_src emacs-lisp\n0 (ref:foo)\n#+end_src"
 	  (org-test-with-temp-text
 	  (org-test-with-temp-text
 	      "#+BEGIN_SRC emacs-lisp :exports code\n0 (ref:foo)\n#+END_SRC"
 	      "#+BEGIN_SRC emacs-lisp :exports code\n0 (ref:foo)\n#+END_SRC"
 	    (let ((org-export-use-babel t)
 	    (let ((org-export-use-babel t)
@@ -574,7 +574,7 @@ src_emacs-lisp{(+ 1 1)}"
 	    (buffer-string))))
 	    (buffer-string))))
   (should
   (should
    (equal
    (equal
-    "#+BEGIN_SRC emacs-lisp -l \"r:%s\"\n1 r:foo\n#+END_SRC"
+    "#+begin_src emacs-lisp -l \"r:%s\"\n1 r:foo\n#+end_src"
     (org-test-with-temp-text
     (org-test-with-temp-text
 	"#+BEGIN_SRC emacs-lisp -l \"r:%s\" -lisp :exports code\n1 r:foo\n#+END_SRC"
 	"#+BEGIN_SRC emacs-lisp -l \"r:%s\" -lisp :exports code\n1 r:foo\n#+END_SRC"
       (let ((org-export-use-babel t))
       (let ((org-export-use-babel t))
@@ -586,7 +586,7 @@ src_emacs-lisp{(+ 1 1)}"
   ;; Pathological case: affiliated keyword matches inline source block
   ;; Pathological case: affiliated keyword matches inline source block
   ;; syntax.
   ;; syntax.
   (should
   (should
-   (equal "#+name: call_foo\n#+BEGIN_SRC emacs-lisp\n42\n#+END_SRC"
+   (equal "#+name: call_foo\n#+begin_src emacs-lisp\n42\n#+end_src"
 	  (org-test-with-temp-text
 	  (org-test-with-temp-text
 	      "#+name: call_foo\n#+BEGIN_SRC emacs-lisp\n42\n#+END_SRC"
 	      "#+name: call_foo\n#+BEGIN_SRC emacs-lisp\n42\n#+END_SRC"
 	    (let ((org-export-use-babel t))
 	    (let ((org-export-use-babel t))