From 2c41ae7704c133086a772b8651a1c3cd67feab78 Mon Sep 17 00:00:00 2001
From: Aaron Ecay <aaronecay@gmail.com>
Date: Sun, 8 Nov 2015 19:37:22 +0000
Subject: [PATCH] draft implementation of org-list-to-subtree in terms of
 org-element

---
 lisp/org-list.el | 104 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 104 insertions(+)

diff --git a/lisp/org-list.el b/lisp/org-list.el
index 19d5b03..1612e4e 100644
--- a/lisp/org-list.el
+++ b/lisp/org-list.el
@@ -3263,6 +3263,110 @@ syntax.  Return converted list as a string."
   (require 'ox-texinfo)
   (org-export-string-as list 'texinfo t))
 
+(defun org-list--partial-parse-contents (parse)
+  "Get the actual contents of a partial org-mode parse.
+
+Specifically, when parsing a piece of text smaller than a
+headline, `org-element-parse-buffer' wraps its result with a
+dummy `section' element, as well as the standard `org-data'
+wrapper.  This function removes these, returning a list of
+org-elements.
+
+TODO: maybe this needs a more general name."
+  (org-element-contents
+   ;; strip the org-data element
+   (nth 0 (org-element-contents
+	   ;; and the section element
+	   parse))))
+
+(defun org-list--split-first-line (contents)
+  "Remove the first line of text from an org-element item.
+
+CONTENTS are the contents of the item org-element: at least a
+paragraph followed by zero or more other elements.
+
+Returns a cons of the first textual line and a list of
+org-elements representing the structure of the item minus this
+line.
+
+TODO: is the first daughter of an item always a paragraph?"
+  (let ((graf (nth 0 contents)))
+    (unless (eq (org-element-type graf) 'paragraph)
+      (error "`org-list--split-first-line' got confused"))
+    (goto-char (org-element-property :begin graf))
+    (let* ((eol (point-at-eol))
+	   (end (org-element-property :end graf))
+	   (first-line (buffer-substring-no-properties (point) eol)))
+      (if (> (1+ eol) end)
+	  ;; One line paragraph: it becomes the entirety of the
+	  ;; headline, and we remove it from contents
+	  (setq contents (cdr contents))
+	;; Multi-line paragraph: narrow the buffer to lines 2-N, parse
+	;; them, and set them as the contents of the paragraph.
+	(save-restriction
+	  (widen)
+	  (narrow-to-region (1+ eol) end)
+	  (org-element-set-contents graf
+				    (org-list--partial-parse-contents
+				     ;; TODO: We're playing a trick on
+				     ;; the parser here.  AFAICT, the
+				     ;; parse does not rely on the
+				     ;; cache.  But maybe we should
+				     ;; let org-element-use-cache to
+				     ;; nil around this call, in case
+				     ;; that changes in the future.
+				     (org-element-parse-buffer)))))
+      (cons first-line contents))))
+
+(defun org-list--item-to-headline (item level)
+  "Convert an org-element list item to a headline.
+
+The first line of the list item becomes the "
+  (unless (eq (car item) 'item)
+    (error "`org-list--item-to-headline' expects an item argument"))
+  (let* ((r (org-list--split-first-line (org-element-contents item)))
+	 (title (car r))
+	 (other-contents (cdr r)))
+    (list 'headline
+	  `(:level ,level
+		   ,@(when (eq (org-element-property :checkbox item) 'on)
+		       (list :todo-keyword
+			     ;; TODO: how to fish the approporiate
+			     ;; value out of org-todo-keywords?
+			     "TODO"))
+		   :title ,title)
+	  (mapcar (lambda (x) (if (eq (org-element-type x) 'plain-list)
+				  (org-list--to-headlines x (1+ level))
+				x))
+		  other-contents))))
+
+(defun org-list--to-headlines (list level)
+  (unless (eq (car list) 'plain-list)
+    (error "`org-list-to-subtree' expects a plain-list argument"))
+  (mapcar (lambda (x) (org-list--item-to-headline x level))
+	  (org-element-contents list)))
+
+(defun org-list-to-subtree2 ()
+  (let* ((e (org-element-at-point))
+	 (l (org-element-lineage e))
+	 (list (cl-find-if (lambda (x) (eq (org-element-type x) 'plain-list))
+			   (nreverse l)))
+	 (level (org-reduced-level (or (org-current-level) 0)))
+	 (begin (org-element-property :begin list))
+	 (end (org-element-property :end list))
+	 (parse (save-restriction
+		  (widen)
+		  (narrow-to-region begin end)
+		  (org-element-parse-buffer)))
+	 (new-subtree (org-list--to-headlines
+		       (nth 0 (org-list--partial-parse-contents parse))
+		       level)))
+    (goto-char end)
+    ;; Don't eat the blank lines after the list.
+    (skip-chars-backward " \n\t\f")
+    (delete-region begin (point))
+    (insert (org-element-interpret-data new-subtree))))
+
 (defun org-list-to-subtree (list &optional params)
   "Convert LIST into an Org subtree.
 LIST is as returned by `org-list-parse-list'.  PARAMS is a property list
-- 
2.6.2