Browse Source

Preserve hierarchy when converting items to headlines and the other way

* lisp/org.el (org-toggle-item, org-toggle-heading): make sure every
  sub-item in a list is changed into a sub-heading and sub-headings
  are translated into sub-items. Also ignore inline tasks in the
  process.

org-toggle-item on headlines preserves hierarchy
Nicolas Goaziou 14 years ago
parent
commit
713262edc1
1 changed files with 129 additions and 92 deletions
  1. 129 92
      lisp/org.el

+ 129 - 92
lisp/org.el

@@ -17571,80 +17571,93 @@ Calls `org-table-insert-hline', `org-toggle-item', or
   "Convert headings or normal lines to items, items to normal lines.
 If there is no active region, only the current line is considered.
 
-If the first line in the region is a headline, convert all
-headlines to items.
+If the first non blank line in the region is an headline, convert
+all headlines to items.
 
-If the first line in the region is an item, convert all items to
-normal lines.
+If it is an item, convert all items to normal lines.
 
-If the first line is normal text, change region into an
-item. With a prefix argument ARG, change each line in region into
-an item."
+If it is normal text, change region into an item. With a prefix
+argument ARG, change each line in region into an item."
   (interactive "P")
   (let (l2 l beg end)
     (if (org-region-active-p)
 	(setq beg (region-beginning) end (region-end))
       (setq beg (point-at-bol)
 	    end (min (1+ (point-at-eol)) (point-max))))
-    (save-excursion
-      (goto-char end)
-      (setq l2 (org-current-line))
-      (goto-char beg)
-      (beginning-of-line 1)
-      ;; Ignore blank lines at beginning of region
-      (skip-chars-forward " \t\r\n")
-      (beginning-of-line 1)
-      (setq l (1- (org-current-line)))
-      (if (org-at-item-p)
-	  ;; We already have items, de-itemize
-	  (while (< (setq l (1+ l)) l2)
-	    (when (org-at-item-p)
-	      (skip-chars-forward " \t")
-	      (delete-region (point) (match-end 0)))
-	    (beginning-of-line 2))
-	(if (org-on-heading-p)
-	    ;; Headings, convert to items
-	    (while (< (setq l (1+ l)) l2)
-	      (if (looking-at org-outline-regexp)
-		  (replace-match (org-list-bullet-string "-") t t))
-	      (beginning-of-line 2))
-	  ;; normal lines, with ARG, turn all of them into items
-	  ;; unless they are already one.
-	  (if arg
-	      (while (< (setq l (1+ l)) l2)
-		(unless (org-at-item-p)
-		  (if (looking-at "\\([ \t]*\\)\\(\\S-\\)")
-		      (replace-match
-		       (concat "\\1" (org-list-bullet-string "-") "\\2"))))
-		(beginning-of-line 2))
-	    ;; Without ARG, make the first line of region an item, and
-	    ;; shift indentation of others lines to set them as item's
-	    ;; body.
-	    (let* ((bul (org-list-bullet-string "-"))
-		   (bul-len (length bul))
-		   (ref-ind (org-get-indentation)))
-	      (skip-chars-forward " \t")
-	      (insert bul)
-	      (beginning-of-line 2)
-	      (while (and (< (setq l (1+ l)) l2) (< (point) end))
-		;; Ensure that lines less indented than first one
-		;; still get included in item body.
-		(org-indent-line-to (+ (max ref-ind (org-get-indentation))
-				       bul-len))
-		(beginning-of-line 2)))))))))
+    (org-with-limited-levels
+     (save-excursion
+       (goto-char end)
+       (setq l2 (org-current-line))
+       (goto-char beg)
+       (beginning-of-line 1)
+       ;; Ignore blank lines at beginning of region
+       (skip-chars-forward " \t\r\n")
+       (beginning-of-line 1)
+       (setq l (1- (org-current-line)))
+       (cond
+	;; Case 1. Start at an item: de-itemize.
+	((org-at-item-p)
+	 (while (< (setq l (1+ l)) l2)
+	   (when (org-at-item-p)
+	     (skip-chars-forward " \t")
+	     (delete-region (point) (match-end 0)))
+	   (beginning-of-line 2)))
+	;; Case 2. Start an an heading: convert to items.
+	((org-on-heading-p)
+	 (let* ((bul (org-list-bullet-string "-"))
+		(len (length bul))
+		(ind 0) (level 0))
+	   (while (< (setq l (1+ l)) l2)
+	     (cond
+	      ((looking-at outline-regexp)
+	       (let* ((lvl (org-reduced-level
+			    (- (length (match-string 0)) 2)))
+		      (s (concat (make-string (* len lvl) ? ) bul)))
+		 (replace-match s t t)
+		 (setq ind (length s) level lvl)))
+	      ;; Ignore blank lines and inline tasks.
+	      ((looking-at "^[ \t]*$"))
+	      ((looking-at "^\\*+ "))
+	      ;; Ensure normal text belongs to the new item.
+	      (t (org-indent-line-to (+ (max (- (org-get-indentation) level 2) 0)
+					ind))))
+	     (beginning-of-line 2))))
+	;; Case 3. Normal line with ARG: turn each of them into items
+	;;         unless they are already one.
+	(arg
+	 (while (< (setq l (1+ l)) l2)
+	   (unless (or (org-on-heading-p) (org-at-item-p))
+	     (if (looking-at "\\([ \t]*\\)\\(\\S-\\)")
+		 (replace-match
+		  (concat "\\1" (org-list-bullet-string "-") "\\2"))))
+	   (beginning-of-line 2)))
+	;; Case 4. Normal line without ARG: make the first line of
+	;;         region an item, and shift indentation of others
+	;;         lines to set them as item's body.
+	(t (let* ((bul (org-list-bullet-string "-"))
+		  (bul-len (length bul))
+		  (ref-ind (org-get-indentation)))
+	     (skip-chars-forward " \t")
+	     (insert bul)
+	     (beginning-of-line 2)
+	     (while (and (< (setq l (1+ l)) l2) (< (point) end))
+	       ;; Ensure that lines less indented than first one
+	       ;; still get included in item body.
+	       (org-indent-line-to (+ (max ref-ind (org-get-indentation))
+				      bul-len))
+	       (beginning-of-line 2)))))))))
 
 (defun org-toggle-heading (&optional nstars)
   "Convert headings to normal text, or items or text to headings.
 If there is no active region, only the current line is considered.
 
-If the first line is a heading, remove the stars from all headlines
-in the region.
+If the first non blank line is an headline, remove the stars from
+all headlines in the region.
 
-If the first line is a plain list item, turn all plain list items
-into headings.
+If it is a plain list item, turn all plain list items into headings.
 
-If the first line is a normal line, turn each and every line in the
-region into a heading.
+If it is a normal line, turn each and every normal line (i.e. not
+an heading or an item) in the region into a heading.
 
 When converting a line into a heading, the number of stars is chosen
 such that the lines become children of the current entry.  However,
@@ -17653,41 +17666,65 @@ stars to add."
   (interactive "P")
   (let (l2 l itemp beg end)
     (if (org-region-active-p)
-	(setq beg (region-beginning) end (region-end))
+	(setq beg (region-beginning) end (copy-marker (region-end)))
       (setq beg (point-at-bol)
 	    end (min (1+ (point-at-eol)) (point-max))))
-    (save-excursion
-      (goto-char end)
-      (setq l2 (org-current-line))
-      (goto-char beg)
-      (beginning-of-line 1)
-      (setq l (1- (org-current-line)))
-      (if (org-on-heading-p)
-	  ;; We already have headlines, de-star them
-	  (while (< (setq l (1+ l)) l2)
-	    (when (org-on-heading-p t)
-	      (and (looking-at outline-regexp) (replace-match "")))
-	    (beginning-of-line 2))
-	(setq itemp (org-at-item-p))
-	(let* ((stars
-		(if nstars
-		    (make-string (prefix-numeric-value current-prefix-arg)
-				 ?*)
-		  (save-excursion
-		    (if (re-search-backward org-complex-heading-regexp nil t)
-			(match-string 1) ""))))
-	       (add-stars (cond (nstars "")
-				((equal stars "") "*")
-				(org-odd-levels-only "**")
-				(t "*")))
-	       (rpl (concat stars add-stars " ")))
-	  (while (< (setq l (1+ l)) l2)
-	    (if itemp
-		(and (org-at-item-p) (replace-match rpl t t))
-	      (unless (org-on-heading-p)
-		(if (looking-at "\\([ \t]*\\)\\(\\S-\\)")
-		    (replace-match (concat rpl (match-string 2))))))
-	    (beginning-of-line 2)))))))
+    ;; Ensure inline tasks don't count as headings.
+    (org-with-limited-levels
+     (save-excursion
+       (goto-char end)
+       (setq l2 (org-current-line))
+       (goto-char beg)
+       (beginning-of-line 1)
+       ;; Ignore blank lines at beginning of region
+       (skip-chars-forward " \t\r\n")
+       (beginning-of-line 1)
+       (setq l (1- (org-current-line)))
+       (cond
+	;; Case 1. Started at an heading: de-star headings.
+	((org-on-heading-p)
+	 (while (< (setq l (1+ l)) l2)
+	   (when (org-on-heading-p t)
+	     (looking-at outline-regexp) (replace-match ""))
+	   (beginning-of-line 2)))
+	;; Case 2. Started at an item: change items into headlines.
+	((org-at-item-p)
+	 (let ((stars (make-string
+		       (if nstars
+			   (prefix-numeric-value current-prefix-arg)
+			 (or (org-current-level) 0))
+		       ?*)))
+	   (while (< (point) end)
+	     (when (org-at-item-p)
+	       ;; Pay attention to cases when region ends before list.
+	       (let* ((struct (org-list-struct))
+		      (list-end (min (org-list-get-bottom-point struct) end)))
+		 (save-restriction
+		   (narrow-to-region (point) list-end)
+		   (insert
+		    (org-list-to-subtree
+		     (org-list-parse-list t)
+		     '(:istart (concat stars (funcall get-stars depth))
+			       :icount (concat stars
+					       (funcall get-stars depth))))))))
+	     (beginning-of-line 2))))
+	;; Case 3. Started at normal text: make every line an heading,
+	;;         skipping headlines and items.
+	(t (let* ((stars (make-string
+			  (if nstars
+			      (prefix-numeric-value current-prefix-arg)
+			    (or (org-current-level) 0))
+			  ?*))
+		  (add-stars (cond (nstars "")
+				   ((equal stars "") "*")
+				   (org-odd-levels-only "**")
+				   (t "*")))
+		  (rpl (concat stars add-stars " ")))
+	     (while (< (setq l (1+ l)) l2)
+	       (unless (or (org-on-heading-p) (org-at-item-p))
+		 (when (looking-at "\\([ \t]*\\)\\(\\S-\\)")
+		   (replace-match (concat rpl (match-string 2)))))
+	       (beginning-of-line 2)))))))))
 
 (defun org-meta-return (&optional arg)
   "Insert a new heading or wrap a region in a table.