Speed-up `org-insert-heading'

* lisp/org.el (org-insert-heading): Refactor to use `org-in-item-p'
  only once.

1 files changed, 159 insertions, 158 deletions

diff --git a/lisp/org.el b/lisp/org.el
index 38b197b..2bb6127 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -7496,165 +7496,166 @@ When INVISIBLE-OK is set, stop at invisible headlines when going back.
 This is important for non-interactive uses of the command."
   (interactive "P")
   (if (org-called-interactively-p 'any) (org-reveal))
-  (cond
-   ((or (= (buffer-size) 0)
-	(and (not (save-excursion
-		    (and (ignore-errors (org-back-to-heading invisible-ok))
-			 (org-at-heading-p))))
-	     (or arg (not (org-in-item-p)))))
-    (insert
-     (if (org-previous-line-empty-p) "" "\n")
-     (if (org-in-src-block-p) ",* " "* "))
-    (run-hooks 'org-insert-heading-hook))
-   ((or arg
-	(and (not (org-in-item-p)) org-insert-heading-respect-content)
-	(not (org-insert-item
-	      (save-excursion
-		(and (org-in-item-p)
-		     (org-beginning-of-item)
-		     (looking-at org-list-full-item-re)
-		     (match-string 3))))))
-    (let (begn endn)
-      (when (org-buffer-narrowed-p)
-	(setq begn (point-min) endn (point-max))
-	(widen))
-      (let* ((empty-line-p nil)
-	     (eops (equal arg '(16))) ; insert at end of parent subtree
-	     (org-insert-heading-respect-content
-	      (or (not (null arg)) org-insert-heading-respect-content))
-	     (level nil)
-	     (on-heading (org-at-heading-p))
-	     ;; Get a level to fall back on
-	     (fix-level
-	      (save-excursion
-		(org-back-to-heading t)
-		(looking-at org-outline-regexp)
-		(make-string (1- (length (match-string 0))) ?*)))
-	     (on-empty-line
-	      (save-excursion (beginning-of-line 1) (looking-at "^\\s-*$")))
-	     (head (save-excursion
-		     (condition-case nil
-			 (progn
-			   (org-back-to-heading invisible-ok)
-			   (when (and (not on-heading)
-				      (featurep 'org-inlinetask)
-				      (integerp org-inlinetask-min-level)
-				      (>= (length (match-string 0))
-					  org-inlinetask-min-level))
-			     ;; Find a heading level before the inline task
-			     (while (and (setq level (org-up-heading-safe))
-					 (>= level org-inlinetask-min-level)))
-			     (if (org-at-heading-p)
-				 (org-back-to-heading invisible-ok)
-			       (error "This should not happen")))
-			   (unless (and (save-excursion
-					  (save-match-data
-					    (org-backward-heading-same-level 1 invisible-ok))
-					  (= (point) (match-beginning 0)))
-					(not (org-previous-line-empty-p t)))
-			     (setq empty-line-p (org-previous-line-empty-p)))
-			   (match-string 0))
-		       (error (or fix-level "* ")))))
-	     (blank-a (cdr (assq 'heading org-blank-before-new-entry)))
-	     (blank (if (eq blank-a 'auto) empty-line-p blank-a))
-	     pos hide-previous previous-pos)
-	(if ;; At the beginning of a heading, open a new line for insertion
-	    (and (bolp) (org-at-heading-p)
-		 (not eops)
-		 (or (bobp)
-		     (save-excursion (backward-char 1) (not (outline-invisible-p)))))
-	    (open-line (if blank 2 1))
-	  (save-excursion
-	    (setq previous-pos (point-at-bol))
-	    (end-of-line)
-	    (setq hide-previous (outline-invisible-p)))
-	  (and org-insert-heading-respect-content
-	       (save-excursion
-		 (while (outline-invisible-p)
-		   (org-show-subtree)
-		   (org-up-heading-safe))))
-	  (let ((split
-		 (and (org-get-alist-option org-M-RET-may-split-line 'headline)
-		      (save-excursion
-			(let ((p (point)))
-			  (goto-char (point-at-bol))
-			  (and (looking-at org-complex-heading-regexp)
-			       (match-beginning 4)
-			       (> p (match-beginning 4)))))))
-		tags pos)
-	    (cond
-	     ;; Insert a new line, possibly at end of parent subtree
-	     ((and (not arg) (not on-heading) (not on-empty-line)
-		   (not (save-excursion
-			  (beginning-of-line 1)
-			  (or (looking-at org-list-full-item-re)
-			      ;; Don't convert :end: lines to headline
-			      (looking-at "^\\s-*:end:")
-			      (looking-at "^\\s-*#\\+end_?")))))
-	      (beginning-of-line 1))
-	     (org-insert-heading-respect-content
-	      (if (not eops)
-		  (progn
-		    (org-end-of-subtree nil t)
-		    (and (looking-at "^\\*") (backward-char 1))
-		    (while (and (not (bobp))
-				;; Don't delete spaces in empty headlines
-				(not (looking-back org-outline-regexp))
-				(member (char-before) '(?\ ?\t ?\n)))
-		      (backward-delete-char 1)))
-		(let ((p (point)))
-		  (org-up-heading-safe)
-		  (if (= p (point))
-		      (goto-char (point-max))
-		    (org-end-of-subtree nil t))))
-	      (when (featurep 'org-inlinetask)
-		(while (and (not (eobp))
-			    (looking-at "\\(\\*+\\)[ \t]+")
-			    (>= (length (match-string 1))
-				org-inlinetask-min-level))
-		  (org-end-of-subtree nil t)))
-	      (or (bolp) (newline))
-	      (or (org-previous-line-empty-p)
-		  (and blank (newline)))
-	      (if (or empty-line-p eops) (open-line 1)))
-	     ;; Insert a headling containing text after point
-	     ((org-at-heading-p)
-	      (when hide-previous
-		(show-children)
-		(org-show-entry))
-	      (looking-at ".*?\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[ \t]*$")
-	      (setq tags (and (match-end 2) (match-string 2)))
-	      (and (match-end 1)
-		   (delete-region (match-beginning 1) (match-end 1)))
-	      (setq pos (point-at-bol))
-	      (or split (end-of-line 1))
-	      (delete-horizontal-space)
-	      (if (string-match "\\`\\*+\\'"
-				(buffer-substring (point-at-bol) (point)))
-		  (insert " "))
-	      (newline (if blank 2 1))
-	      (when tags
+  (let ((itemp (org-in-item-p)))
+    (cond
+     ((or (= (buffer-size) 0)
+	  (and (not (save-excursion
+		      (and (ignore-errors (org-back-to-heading invisible-ok))
+			   (org-at-heading-p))))
+	       (or arg (not itemp))))
+      (insert
+       (if (org-previous-line-empty-p) "" "\n")
+       (if (org-in-src-block-p) ",* " "* "))
+      (run-hooks 'org-insert-heading-hook))
+     ((or arg
+	  (and (not itemp) org-insert-heading-respect-content)
+	  (not (org-insert-item
 		(save-excursion
-		  (goto-char pos)
-		  (end-of-line 1)
-		  (insert " " tags)
-		  (org-set-tags nil 'align))))
-	     (t
-	      (or split (end-of-line 1))
-	      (newline (cond ((and blank (not on-empty-line)) 2)
-			     (blank 1)
-			     (on-empty-line 0) (t 1)))))))
-	(insert head) (just-one-space)
-	(setq pos (point))
-	(end-of-line 1)
-	(unless (= (point) pos) (just-one-space) (backward-delete-char 1))
-	(when (and org-insert-heading-respect-content hide-previous)
-	  (save-excursion
-	    (goto-char previous-pos)
-	    (hide-subtree)))
-	(when (and begn endn)
-	  (narrow-to-region (min (point) begn) (max (point) endn)))
-	(run-hooks 'org-insert-heading-hook))))))
+		  (and itemp
+		       (goto-char itemp)
+		       (looking-at org-list-full-item-re)
+		       (match-string 3))))))
+      (let (begn endn)
+	(when (org-buffer-narrowed-p)
+	  (setq begn (point-min) endn (point-max))
+	  (widen))
+	(let* ((empty-line-p nil)
+	       (eops (equal arg '(16))) ; insert at end of parent subtree
+	       (org-insert-heading-respect-content
+		(or (not (null arg)) org-insert-heading-respect-content))
+	       (level nil)
+	       (on-heading (org-at-heading-p))
+	       ;; Get a level to fall back on
+	       (fix-level
+		(save-excursion
+		  (org-back-to-heading t)
+		  (looking-at org-outline-regexp)
+		  (make-string (1- (length (match-string 0))) ?*)))
+	       (on-empty-line
+		(save-excursion (beginning-of-line 1) (looking-at "^\\s-*$")))
+	       (head (save-excursion
+		       (condition-case nil
+			   (progn
+			     (org-back-to-heading invisible-ok)
+			     (when (and (not on-heading)
+					(featurep 'org-inlinetask)
+					(integerp org-inlinetask-min-level)
+					(>= (length (match-string 0))
+					    org-inlinetask-min-level))
+			       ;; Find a heading level before the inline task
+			       (while (and (setq level (org-up-heading-safe))
+					   (>= level org-inlinetask-min-level)))
+			       (if (org-at-heading-p)
+				   (org-back-to-heading invisible-ok)
+				 (error "This should not happen")))
+			     (unless (and (save-excursion
+					    (save-match-data
+					      (org-backward-heading-same-level 1 invisible-ok))
+					    (= (point) (match-beginning 0)))
+					  (not (org-previous-line-empty-p t)))
+			       (setq empty-line-p (org-previous-line-empty-p)))
+			     (match-string 0))
+			 (error (or fix-level "* ")))))
+	       (blank-a (cdr (assq 'heading org-blank-before-new-entry)))
+	       (blank (if (eq blank-a 'auto) empty-line-p blank-a))
+	       pos hide-previous previous-pos)
+	  (if ;; At the beginning of a heading, open a new line for insertion
+	      (and (bolp) (org-at-heading-p)
+		   (not eops)
+		   (or (bobp)
+		       (save-excursion (backward-char 1) (not (outline-invisible-p)))))
+	      (open-line (if blank 2 1))
+	    (save-excursion
+	      (setq previous-pos (point-at-bol))
+	      (end-of-line)
+	      (setq hide-previous (outline-invisible-p)))
+	    (and org-insert-heading-respect-content
+		 (save-excursion
+		   (while (outline-invisible-p)
+		     (org-show-subtree)
+		     (org-up-heading-safe))))
+	    (let ((split
+		   (and (org-get-alist-option org-M-RET-may-split-line 'headline)
+			(save-excursion
+			  (let ((p (point)))
+			    (goto-char (point-at-bol))
+			    (and (looking-at org-complex-heading-regexp)
+				 (match-beginning 4)
+				 (> p (match-beginning 4)))))))
+		  tags pos)
+	      (cond
+	       ;; Insert a new line, possibly at end of parent subtree
+	       ((and (not arg) (not on-heading) (not on-empty-line)
+		     (not (save-excursion
+			    (beginning-of-line 1)
+			    (or (looking-at org-list-full-item-re)
+				;; Don't convert :end: lines to headline
+				(looking-at "^\\s-*:end:")
+				(looking-at "^\\s-*#\\+end_?")))))
+		(beginning-of-line 1))
+	       (org-insert-heading-respect-content
+		(if (not eops)
+		    (progn
+		      (org-end-of-subtree nil t)
+		      (and (looking-at "^\\*") (backward-char 1))
+		      (while (and (not (bobp))
+				  ;; Don't delete spaces in empty headlines
+				  (not (looking-back org-outline-regexp))
+				  (member (char-before) '(?\ ?\t ?\n)))
+			(backward-delete-char 1)))
+		  (let ((p (point)))
+		    (org-up-heading-safe)
+		    (if (= p (point))
+			(goto-char (point-max))
+		      (org-end-of-subtree nil t))))
+		(when (featurep 'org-inlinetask)
+		  (while (and (not (eobp))
+			      (looking-at "\\(\\*+\\)[ \t]+")
+			      (>= (length (match-string 1))
+				  org-inlinetask-min-level))
+		    (org-end-of-subtree nil t)))
+		(or (bolp) (newline))
+		(or (org-previous-line-empty-p)
+		    (and blank (newline)))
+		(if (or empty-line-p eops) (open-line 1)))
+	       ;; Insert a headling containing text after point
+	       ((org-at-heading-p)
+		(when hide-previous
+		  (show-children)
+		  (org-show-entry))
+		(looking-at ".*?\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[ \t]*$")
+		(setq tags (and (match-end 2) (match-string 2)))
+		(and (match-end 1)
+		     (delete-region (match-beginning 1) (match-end 1)))
+		(setq pos (point-at-bol))
+		(or split (end-of-line 1))
+		(delete-horizontal-space)
+		(if (string-match "\\`\\*+\\'"
+				  (buffer-substring (point-at-bol) (point)))
+		    (insert " "))
+		(newline (if blank 2 1))
+		(when tags
+		  (save-excursion
+		    (goto-char pos)
+		    (end-of-line 1)
+		    (insert " " tags)
+		    (org-set-tags nil 'align))))
+	       (t
+		(or split (end-of-line 1))
+		(newline (cond ((and blank (not on-empty-line)) 2)
+			       (blank 1)
+			       (on-empty-line 0) (t 1)))))))
+	  (insert head) (just-one-space)
+	  (setq pos (point))
+	  (end-of-line 1)
+	  (unless (= (point) pos) (just-one-space) (backward-delete-char 1))
+	  (when (and org-insert-heading-respect-content hide-previous)
+	    (save-excursion
+	      (goto-char previous-pos)
+	      (hide-subtree)))
+	  (when (and begn endn)
+	    (narrow-to-region (min (point) begn) (max (point) endn)))
+	  (run-hooks 'org-insert-heading-hook)))))))
 
 (defun org-get-heading (&optional no-tags no-todo)
   "Return the heading of the current entry, without the stars.