diff options
author | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2015-12-02 23:30:54 +0100 |
---|---|---|
committer | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2015-12-03 09:54:49 +0100 |
commit | 11291ffcd08c17779499463a9f8c13c284058469 (patch) | |
tree | 73ef85b70a216443abff0a923b370367cb470d39 /lisp/org-list.el | |
parent | a5977a274072f6828a91e1131ce6aea9d320cb47 (diff) |
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.
Diffstat (limited to 'lisp/org-list.el')
-rw-r--r-- | lisp/org-list.el | 595 |
1 files changed, 345 insertions, 250 deletions
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: - -: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) |