diff --git a/doc/org.texi b/doc/org.texi index c57cc415a..42b7e3c8b 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 56c55e61f..9f4eb4fce 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 bb2e9c8c3..b6f44cbf3 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 19d5b03f0..8bcd50bcd 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: + "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) diff --git a/lisp/org.el b/lisp/org.el index ee470b46a..db52df89a 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 46bcf08c6..b06c794a8 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" :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