summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2015-12-02 23:30:54 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2015-12-03 09:54:49 +0100
commit11291ffcd08c17779499463a9f8c13c284058469 (patch)
tree73ef85b70a216443abff0a923b370367cb470d39
parenta5977a274072f6828a91e1131ce6aea9d320cb47 (diff)
downloadorg-mode-11291ffcd08c17779499463a9f8c13c284058469.tar.gz
org-list: Radio lists use Org Export library
* lisp/org-list.el (org-list-to-lisp): New function. (org-list-parse-list): Mark function obsolete. (org-list-send-list): (org-list-to-generic): (org-list-make-subtree): Use new function. (org-list-item-trim-br): Remove function. (org-list-to-generic): Use Org Export library. (org-list--depth): (org-list--trailing-newlines): (org-list--generic-eval): (org-list--to-generic-plain-list): (org-list--to-generic-item): New functions. (org-list-to-latex): (org-list-to-html): (org-list-to-texinfo): Apply changes. Allow parameters. (org-list-to-subtree): Apply changes. * lisp/org.el (org-toggle-heading): * lisp/ob-core.el (org-babel-insert-result): Apply changes. * doc/org.texi (Radio lists): Update documentation. * testing/lisp/test-org-list.el (test-org-list/to-generic): New test.
-rw-r--r--doc/org.texi11
-rw-r--r--etc/ORG-NEWS7
-rw-r--r--lisp/ob-core.el10
-rw-r--r--lisp/org-list.el595
-rwxr-xr-xlisp/org.el2
-rw-r--r--testing/lisp/test-org-list.el198
6 files changed, 564 insertions, 259 deletions
diff --git a/doc/org.texi b/doc/org.texi
index c57cc41..42b7e3c 100644
--- a/doc/org.texi
+++ b/doc/org.texi
@@ -18302,22 +18302,25 @@ insert radio list templates in HTML, @LaTeX{} and Texinfo modes by calling
Here are the differences with radio tables:
+@cindex #+ORGLST
@itemize @minus
@item
Orgstruct mode must be active.
@item
Use the @code{ORGLST} keyword instead of @code{ORGTBL}.
@item
-The available translation functions for radio lists don't take
-parameters.
-@item
@kbd{C-c C-c} will work when pressed on the first item of the list.
@end itemize
+Built-in translators functions are : @code{org-list-to-latex},
+@code{org-list-to-html} and @code{org-list-to-texinfo}. They all use the
+generic translator @code{org-list-to-generic}. Please check its
+documentation for a list of supported parameters, which can be used to
+control more accurately how the list should be rendered.
+
Here is a @LaTeX{} example. Let's say that you have this in your
@LaTeX{} file:
-@cindex #+ORGLST
@example
% BEGIN RECEIVE ORGLST to-buy
% END RECEIVE ORGLST to-buy
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 56c55e6..9f4eb4f 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -44,6 +44,11 @@ http://orgmode.org/worg/org-contrib/babel/languages/ob-doc-stan.html
*** New =#+latex_compiler= keyword to set LaTeX compiler.
PDFLaTeX, XeLaTeX, and LuaLaTeX are supported. See the manual for
details.
+*** Rewrite of radio lists
+Radio lists, i.e, Org plain lists in foreign buffers, have been
+rewritten to be on par with Radio tables. You can use a large set of
+parameters to control how a given list should be rendered. See manual
+for details.
*** org-bbdb-anniversaries-future
Used like org-bbdb-anniversaries, it provides a few days warning
for upcoming anniversaries (default: 7 days).
@@ -65,6 +70,8 @@ Use ~org-babel--get-vars~ or ~assq~ instead, as applicable.
Use ~image-file-name-regexp~ instead.
The never-used-in-core ~extensions~ argument has been dropped.
+*** ~org-list-parse-list~ is deprecated
+Use ~org-list-to-lisp~ instead.
*** ~org-on-heading-p~ is deprecated
A comment to this effect was in the source code since 7.8.03, but
now a byte-compiler warning will be generated as well.
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index bb2e9c8..b6f44cb 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -84,8 +84,8 @@
(declare-function org-babel-lob-execute-maybe "ob-lob" ())
(declare-function org-number-sequence "org-compat" (from &optional to inc))
(declare-function org-at-item-p "org-list" ())
-(declare-function org-list-parse-list "org-list" (&optional delete))
(declare-function org-list-to-generic "org-list" (LIST PARAMS))
+(declare-function org-list-to-lisp "org-list" (&optional delete))
(declare-function org-list-struct "org-list" ())
(declare-function org-list-prevs-alist "org-list" (struct))
(declare-function org-list-get-list-end "org-list" (item struct prevs))
@@ -2060,7 +2060,7 @@ Return nil if ELEMENT cannot be read."
(defun org-babel-read-list ()
"Read the list at `point' into emacs-lisp."
(mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval))
- (mapcar #'cadr (cdr (org-list-parse-list)))))
+ (cdr (org-list-to-lisp))))
(defvar org-link-types-re)
(defun org-babel-read-link ()
@@ -2270,8 +2270,10 @@ INFO may provide the values of these header arguments (in the
(org-list-to-generic
(cons 'unordered
(mapcar
- (lambda (el) (list nil (if (stringp el) el (format "%S" el))))
- (if (listp result) result (split-string result "\n" t))))
+ (lambda (e)
+ (list (if (stringp e) e (format "%S" e))))
+ (if (listp result) result
+ (split-string result "\n" t))))
'(:splicep nil :istart "- " :iend "\n")))
"\n"))
;; Try hard to print RESULT as a table. Give up if
diff --git a/lisp/org-list.el b/lisp/org-list.el
index 19d5b03..8bcd50b 100644
--- a/lisp/org-list.el
+++ b/lisp/org-list.el
@@ -2922,103 +2922,85 @@ ignores hidden links."
;;; Send and receive lists
-(defun org-list-parse-list (&optional delete)
+(defun org-list-to-lisp (&optional delete)
"Parse the list at point and maybe DELETE it.
Return a list whose car is a symbol of list type, among
`ordered', `unordered' and `descriptive'. Then, each item is
-a list whose car is counter, and cdr are strings and other
-sub-lists. Inside strings, check-boxes are replaced by
-\"[CBON]\", \"[CBOFF]\" and \"[CBTRANS]\".
+a list of strings and other sub-lists.
For example, the following list:
-1. first item
- + sub-item one
- + [X] sub-item two
- more text in first item
-2. [@3] last item
+ 1. first item
+ + sub-item one
+ + [X] sub-item two
+ more text in first item
+ 2. [@3] last item
-will be parsed as:
+is parsed as
- (ordered
- (nil \"first item\"
- (unordered
- (nil \"sub-item one\")
- (nil \"[CBON] sub-item two\"))
- \"more text in first item\")
- (3 \"last item\"))
+ \(ordered
+ \(\"first item\"
+ \(unordered
+ \(\"sub-item one\")
+ \(\"[X] sub-item two\"))
+ \"more text in first item\")
+ \(\"[@3] last item\"))
-Point is left at list end."
+Point is left at list's end."
(letrec ((struct (org-list-struct))
(prevs (org-list-prevs-alist struct))
(parents (org-list-parents-alist struct))
(top (org-list-get-top-point struct))
(bottom (org-list-get-bottom-point struct))
- (get-text
- ;; 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))))
+ (trim
+ (lambda (text)
+ ;; Remove indentation and final newline from TEXT.
+ (org-remove-indentation
+ (if (string-match-p "\n\\'" text)
+ (substring text 0 -1)
+ text))))
(parse-sublist
- ;; Return a list whose car is list type and cdr a list of
- ;; items' body.
(lambda (e)
+ ;; 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 parse-item e))))
(parse-item
- ;; 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)))))))
+ ;; Return a list containing counter of item, if any,
+ ;; text and any sublist inside it.
+ (let* ((end (org-list-get-item-end e struct))
+ (children (org-list-get-children e struct parents))
+ (body
+ (save-excursion
+ (goto-char e)
+ (looking-at "[ \t]*\\S-+[ \t]*")
+ (list
+ (funcall
+ trim
+ (concat
+ (make-string (string-width (match-string 0)) ?\s)
+ (buffer-substring-no-properties
+ (match-end 0) (or (car children) end))))))))
+ (while children
+ (let* ((child (car children))
+ (sub (org-list-get-all-items child struct prevs))
+ (last-in-sub (car (last sub))))
+ (push (funcall parse-sublist sub) body)
+ ;; Remove whole sub-list from children.
+ (setq children (cdr (memq last-in-sub 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.
+ (let ((sub-end (org-list-get-item-end last-in-sub struct))
+ (next (or (car children) end)))
+ (when (/= sub-end next)
+ (push (funcall
+ trim
+ (buffer-substring-no-properties sub-end next))
+ body)))))
+ (nreverse body)))))
;; Store output, take care of cursor position and deletion of
;; list, then return output.
(prog1 (funcall parse-sublist (org-list-get-all-items top struct prevs))
@@ -3027,13 +3009,15 @@ Point is left at list end."
(delete-region top bottom)
(when (and (not (looking-at "[ \t]*$")) (looking-at org-list-end-re))
(replace-match ""))))))
+(define-obsolete-function-alias
+ 'org-list-parse-list 'org-list-to-lisp "Org 9.0")
(defun org-list-make-subtree ()
"Convert the plain list at point into a subtree."
(interactive)
(if (not (ignore-errors (goto-char (org-in-item-p))))
(error "Not in a list")
- (let ((list (save-excursion (org-list-parse-list t))))
+ (let ((list (save-excursion (org-list-to-lisp t))))
(insert (org-list-to-subtree list)))))
(defun org-list-insert-radio-list ()
@@ -3075,7 +3059,9 @@ for this list."
(re-search-backward "#\\+ORGLST" nil t)
(re-search-forward (org-item-beginning-re) bottom-point t)
(match-beginning 0)))
- (plain-list (buffer-substring-no-properties top-point bottom-point))
+ (plain-list (save-excursion
+ (goto-char top-point)
+ (org-list-to-lisp)))
beg)
(unless (fboundp transform)
(error "No such transformation function %s" transform))
@@ -3099,186 +3085,296 @@ for this list."
(insert txt "\n")))
(message "List converted and installed at receiver location"))))
-(defsubst org-list-item-trim-br (item)
- "Trim line breaks in a list ITEM."
- (setq item (replace-regexp-in-string "\n +" " " item)))
-
(defun org-list-to-generic (list params)
- "Convert a LIST parsed through `org-list-parse-list' to other formats.
-Valid parameters PARAMS are:
-
-:ustart String to start an unordered list
-:uend String to end an unordered list
-
-:ostart String to start an ordered list
-:oend String to end an ordered list
-
-:dstart String to start a descriptive list
-:dend String to end a descriptive list
-:dtstart String to start a descriptive term
-:dtend String to end a descriptive term
-:ddstart String to start a description
-:ddend String to end a description
-
-:splice When set to t, return only list body lines, don't wrap
- them into :[u/o]start and :[u/o]end. Default is nil.
-
-:istart String to start a list item.
-:icount String to start an item with a counter.
-:iend String to end a list item
-:isep String to separate items
-:lsep String to separate sublists
-:csep String to separate text from a sub-list
-
-:cboff String to insert for an unchecked check-box
-:cbon String to insert for a checked check-box
-:cbtrans String to insert for a check-box in transitional state
-
-:nobr Non-nil means remove line breaks in lists items.
-
-Alternatively, each parameter can also be a function returning
-a string. This function is called with one argument, the depth
-of the current sub-list, starting at 0."
- (interactive)
- (letrec ((gval (lambda (v d) (if (functionp v) (funcall v d) v)))
- (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 (funcall gval istart depth)))
- (or (and (string-match "[ \t\n\r]+\\'" s)
- (replace-match "" t t s))
- istart))
- "%s" (funcall gval ddend depth)))
- ((and counter (eq type 'ordered))
- (concat (funcall gval icount depth) "%s"))
- (t (concat (funcall gval istart depth) "%s")))
- (funcall gval iend depth)))
- (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 (funcall gval dtstart depth)
- term
- (funcall gval dtend depth)
- (funcall gval ddstart depth)
- desc))))
- (setcar item first)
- (format fmt
- (mapconcat (lambda (e)
- (if (stringp e) e
- (funcall export-sublist e (1+ depth))))
- item (or (funcall gval csep depth) ""))))))
- (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 (funcall gval ostart depth)
- "%s"
- (funcall gval oend depth)))
- ((eq type 'descriptive)
- (concat (funcall gval dstart)
- "%s"
- (funcall gval dend depth)))
- (t (concat (funcall gval ustart depth)
- "%s"
- (funcall gval uend depth))))
- (funcall gval lsep depth))))
- (format fmt (mapconcat
- (lambda (e) (funcall export-item e type depth))
- items
- (or (funcall gval isep depth) "")))))))
- (concat (funcall export-sublist list 0) "\n")))
-
-(defun org-list-to-latex (list &optional _params)
+ "Convert a LIST parsed through `org-list-to-lisp' to a custom format.
+
+LIST is a list as returned by `org-list-to-lisp', which see.
+PARAMS is a property list of parameters used to tweak the output
+format.
+
+Valid parameters are:
+
+:backend, :raw
+
+ Export back-end used as a basis to transcode elements of the
+ list, when no specific parameter applies to it. It is also
+ used to translate its contents. You can prevent this by
+ setting :raw property to a non-nil value.
+
+:splice
+
+ When non-nil, only export the contents of the top most plain
+ list, effectively ignoring its opening and closing lines.
+
+:ustart, :uend
+
+ Strings to start and end an unordered list. They can also be
+ set to a function returning a string or nil, which will be
+ called with the depth of the list, counting from 1.
+
+:ostart, :oend
+
+ Strings to start and end an ordered list. They can also be set
+ to a function returning a string or nil, which will be called
+ with the depth of the list, counting from 1.
+
+:dstart, :dend
+
+ Strings to start and end a descriptive list. They can also be
+ set to a function returning a string or nil, which will be
+ called with the depth of the list, counting from 1.
+
+:dtstart, :dtend, :ddstart, :ddend
+
+ Strings to start and end a descriptive term.
+
+:istart, :iend
+
+ Strings to start or end a list item, and to start a list item
+ with a counter. They can also be set to a function returning
+ a string or nil, which will be called with the depth of the
+ item, counting from 1.
+
+:icount
+
+ Strings to start a list item with a counter. It can also be
+ set to a function returning a string or nil, which will be
+ called with two arguments: the depth of the item, counting from
+ 1, and the counter. Its value, when non-nil, has precedence
+ over `:istart'.
+
+:isep
+
+ String used to separate items. It can also be set to
+ a function returning a string or nil, which will be called with
+ the depth of the items, counting from 1. It always start on
+ a new line.
+
+:cbon, :cboff, :cbtrans
+
+ String to insert, respectively, an un-checked check-box,
+ a checked check-box and a check-box in transitional state."
+ (require 'ox)
+ (let* ((backend (plist-get params :backend))
+ (custom-backend
+ (org-export-create-backend
+ :parent (or backend 'org)
+ :transcoders
+ `((plain-list . ,(org-list--to-generic-plain-list params))
+ (item . ,(org-list--to-generic-item params))
+ (macro . (lambda (m c i) (org-element-macro-interpreter m nil))))))
+ data info)
+ ;; Write LIST back into Org syntax and parse it.
+ (with-temp-buffer
+ (let ((org-inhibit-startup t)) (org-mode))
+ (letrec ((insert-list
+ (lambda (l)
+ (dolist (i (cdr l))
+ (funcall insert-item i (car l)))))
+ (insert-item
+ (lambda (i type)
+ (let ((start (point)))
+ (insert (if (eq type 'ordered) "1. " "- "))
+ (dolist (e i)
+ (if (consp e) (funcall insert-list e)
+ (insert e)
+ (insert "\n")))
+ (beginning-of-line)
+ (save-excursion
+ (let ((ind (if (eq type 'ordered) 3 2)))
+ (while (> (point) start)
+ (unless (looking-at-p "[ \t]*$")
+ (indent-to ind))
+ (forward-line -1))))))))
+ (funcall insert-list list))
+ (setf data
+ (org-element-map (org-element-parse-buffer) 'plain-list
+ #'identity nil t))
+ (setf info (org-export-get-environment backend nil params)))
+ (when (and backend (symbolp backend) (not (org-export-get-backend backend)))
+ (user-error "Unknown :backend value"))
+ (unless backend (require 'ox-org))
+ ;; When`:raw' property has a non-nil value, turn all objects back
+ ;; into Org syntax.
+ (when (and backend (plist-get params :raw))
+ (org-element-map data org-element-all-objects
+ (lambda (object)
+ (org-element-set-element
+ object (org-element-interpret-data object)))))
+ ;; We use a low-level mechanism to export DATA so as to skip all
+ ;; usual pre-processing and post-processing, i.e., hooks, filters,
+ ;; Babel code evaluation, include keywords and macro expansion,
+ ;; and filters.
+ (let ((output (org-export-data-with-backend data custom-backend info)))
+ ;; Remove final newline.
+ (if (org-string-nw-p output) (substring-no-properties output 0 -1) ""))))
+
+(defun org-list--depth (element)
+ "Return the level of ELEMENT within current plain list.
+ELEMENT is either an item or a plain list."
+ (cl-count-if (lambda (ancestor) (eq (org-element-type ancestor) 'plain-list))
+ (org-element-lineage element nil t)))
+
+(defun org-list--trailing-newlines (string)
+ "Return the number of trailing newlines in STRING."
+ (with-temp-buffer
+ (insert string)
+ (skip-chars-backward " \t\n")
+ (count-lines (line-beginning-position 2) (point-max))))
+
+(defun org-list--generic-eval (value &rest args)
+ "Evaluate VALUE according to its type.
+VALUE is either nil, a string or a function. In the latter case,
+it is called with arguments ARGS."
+ (cond ((null value) nil)
+ ((stringp value) value)
+ ((functionp value) (apply value args))
+ (t (error "Wrong value: %s" value))))
+
+(defun org-list--to-generic-plain-list (params)
+ "Return a transcoder for `plain-list' elements.
+PARAMS is a plist used to tweak the behavior of the transcoder."
+ (let ((ustart (plist-get params :ustart))
+ (uend (plist-get params :uend))
+ (ostart (plist-get params :ostart))
+ (oend (plist-get params :oend))
+ (dstart (plist-get params :dstart))
+ (dend (plist-get params :dend))
+ (splice (plist-get params :splice))
+ (backend (plist-get params :backend)))
+ (lambda (plain-list contents info)
+ (let* ((type (org-element-property :type plain-list))
+ (depth (org-list--depth plain-list))
+ (start (and (not splice)
+ (org-list--generic-eval
+ (pcase type
+ (`ordered ostart)
+ (`unordered ustart)
+ (_ dstart))
+ depth)))
+ (end (and (not splice)
+ (org-list--generic-eval
+ (pcase type
+ (`ordered oend)
+ (`unordered uend)
+ (_ dend))
+ depth))))
+ ;; Make sure trailing newlines in END appear in the output by
+ ;; setting `:post-blank' property to their number.
+ (when end
+ (org-element-put-property
+ plain-list :post-blank (org-list--trailing-newlines end)))
+ ;; Build output.
+ (concat (and start (concat start "\n"))
+ (if (or start end splice (not backend))
+ contents
+ (org-export-with-backend backend plain-list contents info))
+ end)))))
+
+(defun org-list--to-generic-item (params)
+ "Return a transcoder for `item' elements.
+PARAMS is a plist used to tweak the behavior of the transcoder."
+ (let ((backend (plist-get params :backend))
+ (istart (plist-get params :istart))
+ (iend (plist-get params :iend))
+ (isep (plist-get params :isep))
+ (icount (plist-get params :icount))
+ (cboff (plist-get params :cboff))
+ (cbon (plist-get params :cbon))
+ (cbtrans (plist-get params :cbtrans))
+ (dtstart (plist-get params :dtstart))
+ (dtend (plist-get params :dtend))
+ (ddstart (plist-get params :ddstart))
+ (ddend (plist-get params :ddend)))
+ (lambda (item contents info)
+ (let* ((type
+ (org-element-property :type (org-element-property :parent item)))
+ (tag (org-element-property :tag item))
+ (depth (org-list--depth item))
+ (separator (and (org-export-get-next-element item info)
+ (org-list--generic-eval isep depth)))
+ (closing (pcase (org-list--generic-eval iend depth)
+ ((or `nil `"") "\n")
+ ((and (guard separator) s)
+ (if (equal (substring s -1) "\n") s (concat s "\n")))
+ (s s))))
+ ;; When a closing line or a separator is provided, make sure
+ ;; its trailing newlines are taken into account when building
+ ;; output. This is done by setting `:post-blank' property to
+ ;; the number of such lines in the last line to be added.
+ (let ((last-string (or separator closing)))
+ (when last-string
+ (org-element-put-property
+ item
+ :post-blank
+ (max (1- (org-list--trailing-newlines last-string)) 0))))
+ ;; Build output.
+ (concat
+ (let ((c (org-element-property :counter item)))
+ (if c (org-list--generic-eval icount depth c)
+ (org-list--generic-eval istart depth)))
+ (let ((body
+ (if (or istart iend icount cbon cboff cbtrans (not backend)
+ (and (eq type 'descriptive)
+ (or dtstart dtend ddstart ddend)))
+ (concat
+ (pcase (org-element-property :checkbox item)
+ (`on cbon)
+ (`off cboff)
+ (`trans cbtrans))
+ (and tag
+ (concat dtstart
+ (if backend
+ (org-export-data-with-backend
+ tag backend info)
+ (org-element-interpret-data tag))
+ dtend))
+ (and tag ddstart)
+ (if (equal contents "") "" (substring contents 0 -1))
+ (and tag ddend))
+ (org-export-with-backend backend item contents info))))
+ ;; Remove final newline.
+ (if (equal body "") ""
+ (substring (org-element-normalize-string body) 0 -1)))
+ closing
+ separator)))))
+
+(defun org-list-to-latex (list &optional params)
"Convert LIST into a LaTeX list.
-LIST is as string representing the list to transform, as Org
-syntax. Return converted list as a string."
+LIST is a parsed plain list, as returned by `org-list-to-lisp'.
+Return converted list as a string."
(require 'ox-latex)
- (org-export-string-as list 'latex t))
+ (org-list-to-generic list (org-combine-plists '(:backend latex) params)))
-(defun org-list-to-html (list)
+(defun org-list-to-html (list &optional params)
"Convert LIST into a HTML list.
-LIST is as string representing the list to transform, as Org
-syntax. Return converted list as a string."
+LIST is a parsed plain list, as returned by `org-list-to-lisp'.
+Return converted list as a string."
(require 'ox-html)
- (org-export-string-as list 'html t))
+ (org-list-to-generic list (org-combine-plists '(:backend html) params)))
-(defun org-list-to-texinfo (list &optional _params)
+(defun org-list-to-texinfo (list &optional params)
"Convert LIST into a Texinfo list.
-LIST is as string representing the list to transform, as Org
-syntax. Return converted list as a string."
+LIST is a parsed plain list, as returned by `org-list-to-lisp'.
+Return converted list as a string."
(require 'ox-texinfo)
- (org-export-string-as list 'texinfo t))
+ (org-list-to-generic list (org-combine-plists '(:backend texinfo) params)))
(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'."
- (let* ((rule (cdr (assq 'heading org-blank-before-new-entry)))
+ (let* ((blank (pcase (cdr (assq 'heading org-blank-before-new-entry))
+ (`t t)
+ (`auto (save-excursion
+ (org-with-limited-levels (outline-previous-heading))
+ (org-previous-line-empty-p)))))
(level (org-reduced-level (or (org-current-level) 0)))
- (blankp (or (eq rule t)
- (and (eq rule 'auto)
- (save-excursion
- (outline-previous-heading)
- (org-previous-line-empty-p)))))
- (get-stars
- ;; Return the string for the heading, depending on depth
- ;; D of current sub-list.
- (lambda (d)
- (let ((oddeven-level (+ level d 1)))
+ (make-stars
+ (lambda (depth)
+ ;; Return the string for the heading, depending on DEPTH
+ ;; of current sub-list.
+ (let ((oddeven-level (+ level depth)))
(concat (make-string (if org-odd-levels-only
(1- (* 2 oddeven-level))
oddeven-level)
@@ -3287,13 +3383,12 @@ with overruling parameters for `org-list-to-generic'."
(org-list-to-generic
list
(org-combine-plists
- `(:splice t
- :dtstart " " :dtend " "
- :istart ,get-stars
- :icount ,get-stars
- :isep ,(if blankp "\n\n" "\n")
- :csep ,(if blankp "\n\n" "\n")
- :cbon "DONE" :cboff "TODO" :cbtrans "TODO")
+ (list :splice t
+ :istart make-stars
+ :icount make-stars
+ :dtstart " " :dtend " "
+ :isep (if blank "\n\n" "\n")
+ :cbon "DONE " :cboff "TODO " :cbtrans "TODO ")
params))))
(provide 'org-list)
diff --git a/lisp/org.el b/lisp/org.el
index ee470b4..db52df8 100755
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -21612,7 +21612,7 @@ number of stars to add."
(list-end (min (org-list-get-bottom-point struct) (1+ end))))
(save-restriction
(narrow-to-region (point) list-end)
- (insert (org-list-to-subtree (org-list-parse-list t)))))
+ (insert (org-list-to-subtree (org-list-to-lisp t)))))
(setq toggled t))
(forward-line)))
;; Case 3. Started at normal text: make every line an heading,
diff --git a/testing/lisp/test-org-list.el b/testing/lisp/test-org-list.el
index 46bcf08..b06c794 100644
--- a/testing/lisp/test-org-list.el
+++ b/testing/lisp/test-org-list.el
@@ -908,6 +908,204 @@
(forward-line 3)
(org-list-send-list))))
+(ert-deftest test-org-list/to-generic ()
+ "Test `org-list-to-generic' specifications."
+ ;; Test `:ustart' and `:uend' parameters.
+ (should
+ (equal
+ "begin\na"
+ (org-test-with-temp-text "- a"
+ (org-list-to-generic (org-list-to-lisp) '(:ustart "begin")))))
+ (should-not
+ (equal
+ "begin\na"
+ (org-test-with-temp-text "1. a"
+ (org-list-to-generic (org-list-to-lisp) '(:ustart "begin")))))
+ (should
+ (equal
+ "a\nend"
+ (org-test-with-temp-text "- a"
+ (org-list-to-generic (org-list-to-lisp) '(:uend "end")))))
+ (should-not
+ (equal
+ "a\nend"
+ (org-test-with-temp-text "1. a"
+ (org-list-to-generic (org-list-to-lisp) '(:uend "end")))))
+ (should
+ (equal
+ "begin l1\na\nbegin l2\nb\nend l2\nend l1"
+ (org-test-with-temp-text "- a\n - b"
+ (org-list-to-generic
+ (org-list-to-lisp)
+ (list :ustart (lambda (l) (format "begin l%d" l))
+ :uend (lambda (l) (format "end l%d" l)))))))
+ ;; Test `:ostart' and `:oend' parameters.
+ (should
+ (equal
+ "begin\na"
+ (org-test-with-temp-text "1. a"
+ (org-list-to-generic (org-list-to-lisp) '(:ostart "begin")))))
+ (should-not
+ (equal
+ "begin\na"
+ (org-test-with-temp-text "- a"
+ (org-list-to-generic (org-list-to-lisp) '(:ostart "begin")))))
+ (should
+ (equal
+ "a\nend"
+ (org-test-with-temp-text "1. a"
+ (org-list-to-generic (org-list-to-lisp) '(:oend "end")))))
+ (should-not
+ (equal
+ "a\nend"
+ (org-test-with-temp-text "- a"
+ (org-list-to-generic (org-list-to-lisp) '(:oend "end")))))
+ (should
+ (equal
+ "begin l1\na\nbegin l2\nb\nend l2\nend l1"
+ (org-test-with-temp-text "1. a\n 1. b"
+ (org-list-to-generic
+ (org-list-to-lisp)
+ (list :ostart (lambda (l) (format "begin l%d" l))
+ :oend (lambda (l) (format "end l%d" l)))))))
+ ;; Test `:dstart' and `:dend' parameters.
+ (should
+ (equal
+ "begin\ntaga"
+ (org-test-with-temp-text "- tag :: a"
+ (org-list-to-generic (org-list-to-lisp) '(:dstart "begin")))))
+ (should-not
+ (equal
+ "begin\na"
+ (org-test-with-temp-text "- a"
+ (org-list-to-generic (org-list-to-lisp) '(:dstart "begin")))))
+ (should
+ (equal
+ "taga\nend"
+ (org-test-with-temp-text "- tag :: a"
+ (org-list-to-generic (org-list-to-lisp) '(:dend "end")))))
+ (should-not
+ (equal
+ "a\nend"
+ (org-test-with-temp-text "- a"
+ (org-list-to-generic (org-list-to-lisp) '(:dend "end")))))
+ (should
+ (equal
+ "begin l1\ntag1a\nbegin l2\ntag2b\nend l2\nend l1"
+ (org-test-with-temp-text "- tag1 :: a\n - tag2 :: b"
+ (org-list-to-generic
+ (org-list-to-lisp)
+ (list :dstart (lambda (l) (format "begin l%d" l))
+ :dend (lambda (l) (format "end l%d" l)))))))
+ ;; Test `:dtstart', `:dtend', `:ddstart' and `:ddend' parameters.
+ (should
+ (equal
+ ">tag<a"
+ (org-test-with-temp-text "- tag :: a"
+ (org-list-to-generic (org-list-to-lisp) '(:dtstart ">" :dtend "<")))))
+ (should
+ (equal
+ "tag>a<"
+ (org-test-with-temp-text "- tag :: a"
+ (org-list-to-generic (org-list-to-lisp) '(:ddstart ">" :ddend "<")))))
+ ;; Test `:istart' and `:iend' parameters.
+ (should
+ (equal
+ "starta"
+ (org-test-with-temp-text "- a"
+ (org-list-to-generic (org-list-to-lisp) '(:istart "start")))))
+ (should
+ (equal
+ "level1 a\nlevel2 b"
+ (org-test-with-temp-text "- a\n - b"
+ (org-list-to-generic (org-list-to-lisp)
+ '(:istart (lambda (l) (format "level%d "l)))))))
+ (should
+ (equal
+ "a\nblevel2level1"
+ (org-test-with-temp-text "- a\n - b"
+ (org-list-to-generic (org-list-to-lisp)
+ '(:iend (lambda (l) (format "level%d" l)))))))
+ ;; Test `:icount' parameter.
+ (should
+ (equal
+ "counta"
+ (org-test-with-temp-text "1. [@3] a"
+ (org-list-to-generic (org-list-to-lisp) '(:icount "count")))))
+ (should-not
+ (equal
+ "counta"
+ (org-test-with-temp-text "1. a"
+ (org-list-to-generic (org-list-to-lisp) '(:icount "count")))))
+ (should
+ (equal
+ "counta"
+ (org-test-with-temp-text "1. [@3] a"
+ (org-list-to-generic (org-list-to-lisp)
+ '(:icount "count" :istart "start")))))
+ (should
+ (equal
+ "level:1, counter:3 a"
+ (org-test-with-temp-text "1. [@3] a"
+ (org-list-to-generic
+ (org-list-to-lisp)
+ '(:icount (lambda (l c) (format "level:%d, counter:%d " l c)))))))
+ ;; Test `:isep' parameter.
+ (should
+ (equal
+ "a\n--\nb"
+ (org-test-with-temp-text "- a\n- b"
+ (org-list-to-generic (org-list-to-lisp) '(:isep "--")))))
+ (should-not
+ (equal
+ "a\n--\nb"
+ (org-test-with-temp-text "- a\n - b"
+ (org-list-to-generic (org-list-to-lisp) '(:isep "--")))))
+ (should
+ (equal
+ "a\n- 1 -\nb"
+ (org-test-with-temp-text "- a\n- b"
+ (org-list-to-generic (org-list-to-lisp)
+ '(:isep (lambda (l) (format "- %d -" l)))))))
+ ;; Test `:cbon', `:cboff', `:cbtrans'
+ (should
+ (equal
+ "!a"
+ (org-test-with-temp-text "- [X] a"
+ (org-list-to-generic (org-list-to-lisp) '(:cbon "!")))))
+ (should-not
+ (equal
+ "!a"
+ (org-test-with-temp-text "- [X] a"
+ (org-list-to-generic (org-list-to-lisp) '(:cboff "!" :cbtrans "!")))))
+ (should
+ (equal
+ "!a"
+ (org-test-with-temp-text "- [ ] a"
+ (org-list-to-generic (org-list-to-lisp) '(:cboff "!")))))
+ (should-not
+ (equal
+ "!a"
+ (org-test-with-temp-text "- [ ] a"
+ (org-list-to-generic (org-list-to-lisp) '(:cbon "!" :cbtrans "!")))))
+ (should
+ (equal
+ "!a"
+ (org-test-with-temp-text "- [-] a"
+ (org-list-to-generic (org-list-to-lisp) '(:cbtrans "!")))))
+ (should-not
+ (equal
+ "!a"
+ (org-test-with-temp-text "- [-] a"
+ (org-list-to-generic (org-list-to-lisp) '(:cbon "!" :cboff "!")))))
+ ;; Test `:splice' parameter.
+ (should
+ (equal
+ "a"
+ (org-test-with-temp-text "- a"
+ (org-list-to-generic (org-list-to-lisp)
+ '(:ustart "begin" :uend "end" :splice t))))))
+
(ert-deftest test-org-list/to-html ()
"Test `org-list-to-html' specifications."
(should