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.
This commit is contained in:
Nicolas Goaziou 2015-12-02 23:30:54 +01:00
parent a5977a2740
commit 11291ffcd0
6 changed files with 555 additions and 250 deletions

View File

@ -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

View File

@ -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.

View File

@ -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

View File

@ -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:
"Convert a LIST parsed through `org-list-to-lisp' to a custom format.
:ustart String to start an unordered list
:uend String to end an unordered list
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.
:ostart String to start an ordered list
:oend String to end an ordered list
Valid parameters are:
: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
:backend, :raw
: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.
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.
: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
:splice
: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
When non-nil, only export the contents of the top most plain
list, effectively ignoring its opening and closing lines.
:nobr Non-nil means remove line breaks in lists items.
:ustart, :uend
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")))
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.
(defun org-list-to-latex (list &optional _params)
: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)

View File

@ -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,

View File

@ -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