Browse Source

Rewrite org-insert-heading for maintainability

* lisp/org.el (org-insert-heading): Rewritten from scratch.
(org-N-empty-lines-before-current): New function
(org-insert-heading-respect-content): Set the correct argument to
force a heading even in lists.
Carsten Dominik 4 years ago
parent
commit
2b9f8c9433
1 changed files with 103 additions and 137 deletions
  1. 103 137
      lisp/org.el

+ 103 - 137
lisp/org.el

@@ -7527,37 +7527,42 @@ the current headline.  If point is not at the beginning, split the line
 and create a new headline with the text in the current line after point
 \(see `org-M-RET-may-split-line' on how to modify this behavior).
 
+If point is at the beginning of a normal line, turn this line into
+a heading.
+
 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))
-  (let ((itemp (org-in-item-p)))
+  (let ((itemp (org-in-item-p))
+	(may-split (org-get-alist-option org-M-RET-may-split-line 'headline))
+	(respect-content (or org-insert-heading-respect-content
+			     (equal arg '(16))))
+	(initial-content "")
+	(adjust-empty-lines t))
+
     (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))))
+      ;; At beginning of buffer or so hight up that only a heading makes sense.
       (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
-		  (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))
+
+     ((and itemp (not (equal arg '(4))))
+      ;; Insert an item
+      (org-insert-item))
+
+     (t
+      ;; Insert a heading
+      (save-restriction
+	(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
@@ -7566,132 +7571,93 @@ This is important for non-interactive uses of the command."
 		  (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 "* ")))))
+	       (stars
+		(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
+
+	  ;; If we insert after content, move there and clean up whitespace
+	  (when respect-content
+	    (org-end-of-subtree nil t)
+	    (when (looking-at "^\\*")
+	      (backward-char 1)
+	      (insert "\n")))
+
+	  ;; If we are splitting, grab the text that should be moved to the new headline
+	  (when may-split
+	    (if (org-on-heading-p)
+		;; This is a heading, we split intelligently (keeping tags)
+		(let ((pos (point)))
+		  (goto-char (point-at-bol))
+		  (unless (looking-at org-complex-heading-regexp)
+		    (error "This should not happen"))
+		  (when (and (match-beginning 4)
+			     (> pos (match-beginning 4))
+			     (< pos (match-end 4)))
+		    (setq initial-content (buffer-substring pos (match-end 4)))
 		    (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)))
+		    (delete-region (point) (match-end 4))
+		    (if (looking-at "[ \t]*$")
+			(replace-match "")
+		      (insert (make-string (length initial-content) ?\ )))
+		    (setq initial-content (org-trim initial-content)))
+		  (goto-char pos))
+	      ;; a normal line
+	      (setq initial-content (buffer-substring (point) (point-at-eol)))
+	      (delete-region (point) (point-at-eol))
+	      (setq initial-content (org-trim initial-content))))
+
+	  ;; If we are at the beginning of the line, insert before it.  Else after
+	  (cond
+	   ((and (bolp) (looking-at "[ \t]*$")))
+	   ((and (bolp) (not (looking-at "[ \t]*$")))
+	    (open-line 1))
+	   (t
+	    (goto-char (point-at-eol))
+	    (insert "\n")))
+	  
+	  ;; Insert the new heading
+	  (insert stars)
+	  (just-one-space)
+	  (insert initial-content)
+	  (if adjust-empty-lines (org-N-empty-lines-before-current (if empty-line-p 1 0)))
 	  (run-hooks 'org-insert-heading-hook)))))))
 
+(defun org-N-empty-lines-before-current (N)
+  "Make the number of empty lines before current exactly N.
+So this will delete or add empty lines."
+  (save-excursion
+    (goto-char (point-at-bol))
+    (if (looking-back "\\s-+" nil 'greedy)
+	(replace-match ""))
+    (or (bobp) (insert "\n"))
+    (while (> N 0)
+      (insert "\n")
+      (setq N (1- N)))))
+
 (defun org-get-heading (&optional no-tags no-todo)
   "Return the heading of the current entry, without the stars.
 When NO-TAGS is non-nil, don't include tags.
@@ -7763,7 +7729,7 @@ This is a list with the following elements:
   "Insert heading with `org-insert-heading-respect-content' set to t."
   (interactive "P")
   (let ((org-insert-heading-respect-content t))
-    (org-insert-heading arg invisible-ok)))
+    (org-insert-heading '(4) invisible-ok)))
 
 (defun org-insert-todo-heading-respect-content (&optional force-state)
   "Insert TODO heading with `org-insert-heading-respect-content' set to t."