forked from mirrors/org-mode
org-list: Fix unbound depth error
* lisp/org-list.el (org-list-parse-list): Use `letrec'. (org-list-to-generic): Do not allow random sexp, but authorize functions. (org-list-to-subtree): Apply change to previous function. Reported-by: Kaushal Modi <kaushal.modi@gmail.com> <http://permalink.gmane.org/gmane.emacs.orgmode/102651>
This commit is contained in:
Nicolas Goaziou
parent
49d3d06cb4
commit
df321b097f
256
lisp/org-list.el
256
lisp/org-list.el
|
|
@ -2950,89 +2950,83 @@ will be parsed as:
|
|||
(3 \"last item\"))
|
||||
|
||||
Point is left at list end."
|
||||
(defvar parse-item) ;FIXME: Or use `cl-labels' or `letrec'.
|
||||
(let* ((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))
|
||||
out
|
||||
(get-text
|
||||
(function
|
||||
;; Return text between BEG and END, trimmed, with
|
||||
;; checkboxes replaced.
|
||||
(lambda (beg end)
|
||||
(let ((text (org-trim (buffer-substring beg end))))
|
||||
(if (string-match "\\`\\[\\([-X ]\\)\\]" text)
|
||||
(replace-match
|
||||
(let ((box (match-string 1 text)))
|
||||
(cond
|
||||
((equal box " ") "CBOFF")
|
||||
((equal box "-") "CBTRANS")
|
||||
(t "CBON")))
|
||||
t nil text 1)
|
||||
text)))))
|
||||
(parse-sublist
|
||||
(function
|
||||
;; Return a list whose car is list type and cdr a list of
|
||||
;; items' body.
|
||||
(lambda (e)
|
||||
(cons (org-list-get-list-type (car e) struct prevs)
|
||||
(mapcar parse-item e)))))
|
||||
(parse-item
|
||||
(function
|
||||
;; Return a list containing counter of item, if any, text
|
||||
;; and any sublist inside it.
|
||||
(lambda (e)
|
||||
(let ((start (save-excursion
|
||||
(goto-char e)
|
||||
(looking-at "[ \t]*\\S-+\\([ \t]+\\[@\\(start:\\)?\\([0-9]+\\|[a-zA-Z]\\)\\]\\)?[ \t]*")
|
||||
(match-end 0)))
|
||||
;; Get counter number. For alphabetic counter, get
|
||||
;; its position in the alphabet.
|
||||
(counter (let ((c (org-list-get-counter e struct)))
|
||||
(cond
|
||||
((not c) nil)
|
||||
((string-match "[A-Za-z]" c)
|
||||
(- (string-to-char (upcase (match-string 0 c)))
|
||||
64))
|
||||
((string-match "[0-9]+" c)
|
||||
(string-to-number (match-string 0 c))))))
|
||||
(childp (org-list-has-child-p e struct))
|
||||
(end (org-list-get-item-end e struct)))
|
||||
;; If item has a child, store text between bullet and
|
||||
;; next child, then recursively parse all sublists. At
|
||||
;; the end of each sublist, check for the presence of
|
||||
;; text belonging to the original item.
|
||||
(if childp
|
||||
(let* ((children (org-list-get-children e struct parents))
|
||||
(body (list (funcall get-text start childp))))
|
||||
(while children
|
||||
(let* ((first (car children))
|
||||
(sub (org-list-get-all-items first struct prevs))
|
||||
(last-c (car (last sub)))
|
||||
(last-end (org-list-get-item-end last-c struct)))
|
||||
(push (funcall parse-sublist sub) body)
|
||||
;; Remove children from the list just parsed.
|
||||
(setq children (cdr (member last-c children)))
|
||||
;; There is a chunk of text belonging to the
|
||||
;; item if last child doesn't end where next
|
||||
;; child starts or where item ends.
|
||||
(unless (= (or (car children) end) last-end)
|
||||
(push (funcall get-text
|
||||
last-end (or (car children) end))
|
||||
body))))
|
||||
(cons counter (nreverse body)))
|
||||
(list counter (funcall get-text start end))))))))
|
||||
(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))))
|
||||
(parse-sublist
|
||||
;; Return a list whose car is list type and cdr a list of
|
||||
;; items' body.
|
||||
(lambda (e)
|
||||
(cons (org-list-get-list-type (car e) struct prevs)
|
||||
(mapcar parse-item e))))
|
||||
(parse-item
|
||||
;; 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)))))))
|
||||
;; Store output, take care of cursor position and deletion of
|
||||
;; list, then return output.
|
||||
(setq out (funcall parse-sublist (org-list-get-all-items top struct prevs)))
|
||||
(goto-char top)
|
||||
(when delete
|
||||
(delete-region top bottom)
|
||||
(when (and (not (looking-at "[ \t]*$")) (looking-at org-list-end-re))
|
||||
(replace-match "")))
|
||||
out))
|
||||
(prog1 (funcall parse-sublist (org-list-get-all-items top struct prevs))
|
||||
(goto-char top)
|
||||
(when delete
|
||||
(delete-region top bottom)
|
||||
(when (and (not (looking-at "[ \t]*$")) (looking-at org-list-end-re))
|
||||
(replace-match ""))))))
|
||||
|
||||
(defun org-list-make-subtree ()
|
||||
"Convert the plain list at point into a subtree."
|
||||
|
|
@ -3142,14 +3136,12 @@ Valid parameters PARAMS are:
|
|||
|
||||
:nobr Non-nil means remove line breaks in lists items.
|
||||
|
||||
Alternatively, each parameter can also be a form returning
|
||||
a string. These sexp can use keywords `counter' and `depth',
|
||||
representing respectively counter associated to the current
|
||||
item, and depth of the current sub-list, starting at 0.
|
||||
Obviously, `counter' is only available for parameters applying to
|
||||
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 ((p params)
|
||||
(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))
|
||||
|
|
@ -3182,15 +3174,15 @@ items."
|
|||
((eq type 'descriptive)
|
||||
;; Stick DTSTART to ISTART by
|
||||
;; left-trimming the latter.
|
||||
(concat (let ((s (eval istart)))
|
||||
(concat (let ((s (funcall gval istart depth)))
|
||||
(or (and (string-match "[ \t\n\r]+\\'" s)
|
||||
(replace-match "" t t s))
|
||||
istart))
|
||||
"%s" (eval ddend)))
|
||||
"%s" (funcall gval ddend depth)))
|
||||
((and counter (eq type 'ordered))
|
||||
(concat (eval icount) "%s"))
|
||||
(t (concat (eval istart) "%s")))
|
||||
(eval iend)))
|
||||
(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
|
||||
|
|
@ -3212,30 +3204,42 @@ items."
|
|||
"???"))
|
||||
(desc (if complete (substring first (match-end 0))
|
||||
first)))
|
||||
(setq first (concat (eval dtstart) term (eval dtend)
|
||||
(eval ddstart) desc))))
|
||||
(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 (eval csep) ""))))))
|
||||
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 (eval ostart) "%s" (eval oend)))
|
||||
((eq type 'descriptive)
|
||||
(concat (eval dstart) "%s" (eval dend)))
|
||||
(t (concat (eval ustart) "%s" (eval uend))))
|
||||
(eval lsep))))
|
||||
(format fmt (mapconcat (lambda (e)
|
||||
(funcall export-item e type depth))
|
||||
items (or (eval isep) "")))))))
|
||||
(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)
|
||||
|
|
@ -3263,35 +3267,33 @@ syntax. Return converted list as a string."
|
|||
"Convert LIST into an Org subtree.
|
||||
LIST is as returned by `org-list-parse-list'. PARAMS is a property list
|
||||
with overruling parameters for `org-list-to-generic'."
|
||||
(defvar get-stars) (defvar org--blankp)
|
||||
(let* ((rule (cdr (assq 'heading org-blank-before-new-entry)))
|
||||
(level (org-reduced-level (or (org-current-level) 0)))
|
||||
(org--blankp (or (eq rule t)
|
||||
(blankp (or (eq rule t)
|
||||
(and (eq rule 'auto)
|
||||
(save-excursion
|
||||
(outline-previous-heading)
|
||||
(org-previous-line-empty-p)))))
|
||||
(get-stars ;FIXME: Can't rename without renaming it in org.el as well!
|
||||
(function
|
||||
;; Return the string for the heading, depending on depth D
|
||||
;; of current sub-list.
|
||||
(lambda (d)
|
||||
(let ((oddeven-level (+ level d 1)))
|
||||
(concat (make-string (if org-odd-levels-only
|
||||
(1- (* 2 oddeven-level))
|
||||
oddeven-level)
|
||||
?*)
|
||||
" "))))))
|
||||
(get-stars
|
||||
;; Return the string for the heading, depending on depth
|
||||
;; D of current sub-list.
|
||||
(lambda (d)
|
||||
(let ((oddeven-level (+ level d 1)))
|
||||
(concat (make-string (if org-odd-levels-only
|
||||
(1- (* 2 oddeven-level))
|
||||
oddeven-level)
|
||||
?*)
|
||||
" ")))))
|
||||
(org-list-to-generic
|
||||
list
|
||||
(org-combine-plists
|
||||
'(:splice t
|
||||
:dtstart " " :dtend " "
|
||||
:istart (funcall get-stars depth)
|
||||
:icount (funcall get-stars depth)
|
||||
:isep (if org--blankp "\n\n" "\n")
|
||||
:csep (if org--blankp "\n\n" "\n")
|
||||
:cbon "DONE" :cboff "TODO" :cbtrans "TODO")
|
||||
`(: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")
|
||||
params))))
|
||||
|
||||
(provide 'org-list)
|
||||
|
|
|
|||
Loading…
Reference in a new issue