From d4b3d0e9ec19d6c2bca8a53313c260b266437c00 Mon Sep 17 00:00:00 2001
From: Aaron Ecay <aaronecay@gmail.com>
Date: Fri, 6 Nov 2015 20:38:08 +0000
Subject: [PATCH] draft patch to fix org-list

---
 lisp/org-list.el | 328 ++++++++++++++++++++++++++-----------------------------
 1 file changed, 153 insertions(+), 175 deletions(-)

diff --git a/lisp/org-list.el b/lisp/org-list.el
index 683a643..060fda3 100644
--- a/lisp/org-list.el
+++ b/lisp/org-list.el
@@ -2922,6 +2922,66 @@ ignores hidden links."
 
 ;;; Send and receive lists
 
+(defun org-list--get-text (beg end)
+  "Return text between BEG and END, trimmed, with checkboxes replaced."
+  (let ((text (org-trim (buffer-substring beg end))))
+    (if (string-match "\\`\\[\\([-X ]\\)\\]" text)
+	(replace-match
+	 (let ((box (match-string 1 text)))
+	   (cond
+	    ((equal box " ") "CBOFF")
+	    ((equal box "-") "CBTRANS")
+	    (t "CBON")))
+	 t nil text 1)
+      text)))
+
+(defun org-list--parse-item (e struct parents prevs)
+  "Return a list containing counter of item, if any, text and any sublist inside it."
+  (let ((start (save-excursion
+		 (goto-char e)
+		 (looking-at "[ \t]*\\S-+\\([ \t]+\\[@\\(start:\\)?\\([0-9]+\\|[a-zA-Z]\\)\\]\\)?[ \t]*")
+		 (match-end 0)))
+	;; Get counter number.  For alphabetic counter, get
+	;; its position in the alphabet.
+	(counter (let ((c (org-list-get-counter e struct)))
+		   (cond
+		    ((not c) nil)
+		    ((string-match "[A-Za-z]" c)
+		     (- (string-to-char (upcase (match-string 0 c)))
+			64))
+		    ((string-match "[0-9]+" c)
+		     (string-to-number (match-string 0 c))))))
+	(childp (org-list-has-child-p e struct))
+	(end (org-list-get-item-end e struct)))
+    ;; If item has a child, store text between bullet and
+    ;; next child, then recursively parse all sublists.  At
+    ;; the end of each sublist, check for the presence of
+    ;; text belonging to the original item.
+    (if childp
+	(let* ((children (org-list-get-children e struct parents))
+	       (body (list (org-list--get-text start childp))))
+	  (while children
+	    (let* ((first (car children))
+		   (sub (org-list-get-all-items first struct prevs))
+		   (last-c (car (last sub)))
+		   (last-end (org-list-get-item-end last-c struct)))
+	      (push (org-list--parse-sublist sub struct parents prevs) body)
+	      ;; Remove children from the list just parsed.
+	      (setq children (cdr (member last-c children)))
+	      ;; There is a chunk of text belonging to the
+	      ;; item if last child doesn't end where next
+	      ;; child starts or where item ends.
+	      (unless (= (or (car children) end) last-end)
+		(push (org-list--get-text last-end (or (car children) end))
+		      body))))
+	  (cons counter (nreverse body)))
+      (list counter (org-list--get-text start end)))))
+
+(defun org-list--parse-sublist (e struct parents prevs)
+  "Return a list whose car is list type and cdr a list of items' body."
+  (cons (org-list-get-list-type (car e) struct prevs)
+	(mapcar (lambda (x) (org-list--parse-item x struct parents prevs)) e)))
+
 (defun org-list-parse-list (&optional delete)
   "Parse the list at point and maybe DELETE it.
 
@@ -2956,77 +3016,10 @@ Point is left at list end."
 	 (parents (org-list-parents-alist struct))
 	 (top (org-list-get-top-point struct))
 	 (bottom (org-list-get-bottom-point struct))
-	 out
-	 (get-text
-	  (function
-	   ;; Return text between BEG and END, trimmed, with
-	   ;; checkboxes replaced.
-	   (lambda (beg end)
-	     (let ((text (org-trim (buffer-substring beg end))))
-	       (if (string-match "\\`\\[\\([-X ]\\)\\]" text)
-		   (replace-match
-		    (let ((box (match-string 1 text)))
-		      (cond
-		       ((equal box " ") "CBOFF")
-		       ((equal box "-") "CBTRANS")
-		       (t "CBON")))
-		    t nil text 1)
-		 text)))))
-	 (parse-sublist
-	  (function
-	   ;; Return a list whose car is list type and cdr a list of
-	   ;; items' body.
-	   (lambda (e)
-	     (cons (org-list-get-list-type (car e) struct prevs)
-		   (mapcar parse-item e)))))
-	 (parse-item
-	  (function
-	   ;; Return a list containing counter of item, if any, text
-	   ;; and any sublist inside it.
-	   (lambda (e)
-	     (let ((start (save-excursion
-			    (goto-char e)
-			    (looking-at "[ \t]*\\S-+\\([ \t]+\\[@\\(start:\\)?\\([0-9]+\\|[a-zA-Z]\\)\\]\\)?[ \t]*")
-			    (match-end 0)))
-		   ;; Get counter number.  For alphabetic counter, get
-		   ;; its position in the alphabet.
-		   (counter (let ((c (org-list-get-counter e struct)))
-			      (cond
-			       ((not c) nil)
-			       ((string-match "[A-Za-z]" c)
-				(- (string-to-char (upcase (match-string 0 c)))
-				   64))
-			       ((string-match "[0-9]+" c)
-				(string-to-number (match-string 0 c))))))
-		   (childp (org-list-has-child-p e struct))
-		   (end (org-list-get-item-end e struct)))
-	       ;; If item has a child, store text between bullet and
-	       ;; next child, then recursively parse all sublists.  At
-	       ;; the end of each sublist, check for the presence of
-	       ;; text belonging to the original item.
-	       (if childp
-		   (let* ((children (org-list-get-children e struct parents))
-			  (body (list (funcall get-text start childp))))
-		     (while children
-		       (let* ((first (car children))
-			      (sub (org-list-get-all-items first struct prevs))
-			      (last-c (car (last sub)))
-			      (last-end (org-list-get-item-end last-c struct)))
-			 (push (funcall parse-sublist sub) body)
-			 ;; Remove children from the list just parsed.
-			 (setq children (cdr (member last-c children)))
-			 ;; There is a chunk of text belonging to the
-			 ;; item if last child doesn't end where next
-			 ;; child starts or where item ends.
-			 (unless (= (or (car children) end) last-end)
-			   (push (funcall get-text
-					  last-end (or (car children) end))
-				 body))))
-		     (cons counter (nreverse body)))
-		 (list counter (funcall get-text start end))))))))
+	 out)
     ;; Store output, take care of cursor position and deletion of
     ;; list, then return output.
-    (setq out (funcall parse-sublist (org-list-get-all-items top struct prevs)))
+    (setq out (org-list--parse-sublist (org-list-get-all-items top struct prevs) struct parents prevs))
     (goto-char top)
     (when delete
       (delete-region top bottom)
@@ -3109,6 +3102,79 @@ for this list."
   "Trim line breaks in a list ITEM."
   (setq item (replace-regexp-in-string "\n +" " " item)))
 
+(defun org-list--export-item (item type depth plist)
+  "Export an item ITEM of type TYPE, at DEPTH.
+
+First string in item is treated in a special way as it can bring
+extra information that needs to be processed."
+  (let* ((counter (pop item))
+	 (istart (plist-get plist :istart))
+	 (istart-depth (funcall istart depth))
+	 (icount (plist-get plist :icount))
+	 (icount-depth (funcall icount depth))
+	 (fmt (concat
+	       (cond
+	 	((eq type 'descriptive)
+	 	 ;; Stick DTSTART to ISTART by
+	 	 ;; left-trimming the latter.
+	 	 (concat (or (and (string-match "[ \t\n\r]+\\'" istart-depth)
+				  (replace-match "" t t istart-depth))
+			     istart-depth)
+	 		 "%s" (plist-get plist :ddend)))
+	 	((and counter (eq type 'ordered))
+	 	 (concat icount-depth "%s"))
+	 	(t (concat istart-depth "%s")))
+	       (plist-get plist :iend)))
+	 (first (car item)))
+    ;; Replace checkbox if any is found.
+    (cond
+     ((string-match "\\[CBON\\]" first)
+      (setq first (replace-match (plist-get plist :cbon) t t first)))
+     ((string-match "\\[CBOFF\\]" first)
+      (setq first (replace-match (plist-get plist :cboff) t t first)))
+     ((string-match "\\[CBTRANS\\]" first)
+      (setq first (replace-match (plist-get plist :cbtrans) t t first)))
+     )
+    ;; Replace line breaks if required
+    (when (plist-get plist :nobr) (setq first (org-list-item-trim-br first)))
+    ;; Insert descriptive term if TYPE is `descriptive'.
+    (when (eq type 'descriptive)
+      (let* ((complete
+    	      (string-match "^\\(.*\\)[ \t]+::[ \t]*" first))
+    	     (term (if complete
+    		       (save-match-data
+    			 (org-trim (match-string 1 first)))
+    		     "???"))
+    	     (desc (if complete (substring first (match-end 0))
+    		     first)))
+    	(setq first (concat (plist-get plist :dtstart)
+    			    term
+    			    (plist-get plist :dtend)
+    			    (plist-get plist :ddstart)
+    			    desc))))
+    (setcar item first)
+    (format fmt
+    	    (mapconcat (lambda (e)
+    			 (if (stringp e) e
+    			   (org-list--export-sublist e (1+ depth) plist)))
+    		       item (or (plist-get plist :csep) "")))))
+
+(defun org-list--export-sublist (sub depth plist)
+  "Export sublist SUB at DEPTH."
+  (let* ((type (car sub))
+	 (items (cdr sub))
+	 (fmt (concat (cond
+		       ((plist-get plist :splicep) "%s")
+		       ((eq type 'ordered)
+			(concat (plist-get plist :ostart) "%s" (plist-get plist :oend)))
+		       ((eq type 'descriptive)
+			(concat (plist-get plist :dstart) "%s" (plist-get plist :dend)))
+		       (t (concat (plist-get plist :ustart) "%s" (plist-get plist :uend))))
+		      (plist-get plist :lsep))))
+    (format fmt (mapconcat (lambda (e)
+			     (org-list--export-item e type depth plist))
+			   items (or (plist-get plist :isep) "")))))
+
 (defun org-list-to-generic (list params)
   "Convert a LIST parsed through `org-list-parse-list' to other formats.
 Valid parameters PARAMS are:
@@ -3149,94 +3215,7 @@ item, and depth of the current sub-list, starting at 0.
 Obviously, `counter' is only available for parameters applying to
 items."
   (interactive)
-  (letrec ((p params)
-	   (splicep (plist-get p :splice))
-	   (ostart (plist-get p :ostart))
-	   (oend (plist-get p :oend))
-	   (ustart (plist-get p :ustart))
-	   (uend (plist-get p :uend))
-	   (dstart (plist-get p :dstart))
-	   (dend (plist-get p :dend))
-	   (dtstart (plist-get p :dtstart))
-	   (dtend (plist-get p :dtend))
-	   (ddstart (plist-get p :ddstart))
-	   (ddend (plist-get p :ddend))
-	   (istart (plist-get p :istart))
-	   (icount (plist-get p :icount))
-	   (iend (plist-get p :iend))
-	   (isep (plist-get p :isep))
-	   (lsep (plist-get p :lsep))
-	   (csep (plist-get p :csep))
-	   (cbon (plist-get p :cbon))
-	   (cboff (plist-get p :cboff))
-	   (cbtrans (plist-get p :cbtrans))
-	   (nobr (plist-get p :nobr))
-	   (export-item
-	    ;; Export an item ITEM of type TYPE, at DEPTH.  First
-	    ;; string in item is treated in a special way as it can
-	    ;; bring extra information that needs to be processed.
-	    (lambda (item type depth)
-	      (let* ((counter (pop item))
-		     (fmt (concat
-			   (cond
-			    ((eq type 'descriptive)
-			     ;; Stick DTSTART to ISTART by
-			     ;; left-trimming the latter.
-			     (concat (let ((s (eval istart)))
-				       (or (and (string-match "[ \t\n\r]+\\'" s)
-						(replace-match "" t t s))
-					   istart))
-				     "%s" (eval ddend)))
-			    ((and counter (eq type 'ordered))
-			     (concat (eval icount) "%s"))
-			    (t (concat (eval istart) "%s")))
-			   (eval iend)))
-		     (first (car item)))
-		;; Replace checkbox if any is found.
-		(cond
-		 ((string-match "\\[CBON\\]" first)
-		  (setq first (replace-match cbon t t first)))
-		 ((string-match "\\[CBOFF\\]" first)
-		  (setq first (replace-match cboff t t first)))
-		 ((string-match "\\[CBTRANS\\]" first)
-		  (setq first (replace-match cbtrans t t first))))
-		;; Replace line breaks if required
-		(when nobr (setq first (org-list-item-trim-br first)))
-		;; Insert descriptive term if TYPE is `descriptive'.
-		(when (eq type 'descriptive)
-		  (let* ((complete
-			  (string-match "^\\(.*\\)[ \t]+::[ \t]*" first))
-			 (term (if complete
-				   (save-match-data
-				     (org-trim (match-string 1 first)))
-				 "???"))
-			 (desc (if complete (substring first (match-end 0))
-				 first)))
-		    (setq first (concat (eval dtstart) term (eval dtend)
-					(eval ddstart) desc))))
-		(setcar item first)
-		(format fmt
-			(mapconcat (lambda (e)
-				     (if (stringp e) e
-				       (funcall export-sublist e (1+ depth))))
-				   item (or (eval csep) ""))))))
-	   (export-sublist
-	    (lambda (sub depth)
-	      ;; Export sublist SUB at DEPTH.
-	      (let* ((type (car sub))
-		     (items (cdr sub))
-		     (fmt (concat (cond
-				   (splicep "%s")
-				   ((eq type 'ordered)
-				    (concat (eval ostart) "%s" (eval oend)))
-				   ((eq type 'descriptive)
-				    (concat (eval dstart) "%s" (eval dend)))
-				   (t (concat (eval ustart) "%s" (eval uend))))
-				  (eval lsep))))
-		(format fmt (mapconcat (lambda (e)
-					 (funcall export-item e type depth))
-				       items (or (eval isep) "")))))))
-    (concat (funcall export-sublist list 0) "\n")))
+  (concat (org-list--export-sublist list 0 params) "\n"))
 
 (defun org-list-to-latex (list &optional _params)
   "Convert LIST into a LaTeX list.
@@ -3259,38 +3238,37 @@ syntax.  Return converted list as a string."
   (require 'ox-texinfo)
   (org-export-string-as list 'texinfo t))
 
+
+(defun org-list--get-stars (level d)
+  "Return the string for the heading, depending on depth D of
+current sub-list."
+  (let ((oddeven-level (+ level d 1)))
+    (concat (make-string (if org-odd-levels-only
+			     (1- (* 2 oddeven-level))
+			   oddeven-level)
+			 ?*)
+	    " ")))
+
 (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
 with overruling parameters for `org-list-to-generic'."
-  (defvar get-stars) (defvar org--blankp)
   (let* ((rule (cdr (assq 'heading org-blank-before-new-entry)))
 	 (level (org-reduced-level (or (org-current-level) 0)))
 	 (org--blankp (or (eq rule t)
 		     (and (eq rule 'auto)
 			  (save-excursion
 			    (outline-previous-heading)
-			    (org-previous-line-empty-p)))))
-	 (get-stars ;FIXME: Can't rename without renaming it in org.el as well!
-	  (function
-	   ;; Return the string for the heading, depending on depth D
-	   ;; of current sub-list.
-	   (lambda (d)
-	     (let ((oddeven-level (+ level d 1)))
-	       (concat (make-string (if org-odd-levels-only
-					(1- (* 2 oddeven-level))
-				      oddeven-level)
-				    ?*)
-		       " "))))))
+			    (org-previous-line-empty-p))))))
     (org-list-to-generic
      list
      (org-combine-plists
-      '(:splice t
+      `(:splice t
         :dtstart " " :dtend " "
-        :istart (funcall get-stars depth)
-        :icount (funcall get-stars depth)
-        :isep (if org--blankp "\n\n" "\n")
-        :csep (if org--blankp "\n\n" "\n")
+        :istart (lambda (d) (org-list--get-stars ,level d))
+        :icount (lambda (d) (org-list--get-stars ,level d))
+        :isep (if ,org--blankp "\n\n" "\n")
+        :csep (if ,org--blankp "\n\n" "\n")
         :cbon "DONE" :cboff "TODO" :cbtrans "TODO")
       params))))
 
-- 
2.6.2