From: Aaron Ecay <aaronecay@gmail.com>
To: Kaushal Modi <kaushal.modi@gmail.com>,
emacs-org list <emacs-orgmode@gnu.org>
Subject: Re: Lexical binding bug in org-list.el?
Date: Fri, 06 Nov 2015 20:45:56 +0000 [thread overview]
Message-ID: <87wptuua9n.fsf@gmail.com> (raw)
In-Reply-To: <CAFyQvY2ZqKCn5fkyzq9qZU2+qGxhtf8R3m6LmN=j2QS66o+D-A@mail.gmail.com>
[-- Attachment #1: Type: text/plain, Size: 597 bytes --]
Hi Kaushal,
I can reproduce the bug, and you’re right about the cause. I made the
attached patch, which seems to get the code back on its feet. But I
just sort of fiddled with it until all the lexical scoping warnings from
the compiler went away; I have no idea whether it’s correct.
The org-list code is a mess, and I think we should hold off on converting
it to lexical scoping until it can be refactored in a more dedicated way.
Nonetheless I include the patch, in case it’s helpful to anyone.
Thanks for the report (and the very easy test case! :) ),
--
Aaron Ecay
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-draft-patch-to-fix-org-list.patch --]
[-- Type: text/x-diff, Size: 14913 bytes --]
From d4b3d0e9ec19d6c2bca8a53313c260b266437c00 Mon Sep 17 00:00:00 2001
From: Aaron Ecay <aaronecay@gmail.com>
Date: Fri, 6 Nov 2015 20:38:08 +0000
Subject: [PATCH] draft patch to fix org-list
---
lisp/org-list.el | 328 ++++++++++++++++++++++++++-----------------------------
1 file changed, 153 insertions(+), 175 deletions(-)
diff --git a/lisp/org-list.el b/lisp/org-list.el
index 683a643..060fda3 100644
--- a/lisp/org-list.el
+++ b/lisp/org-list.el
@@ -2922,6 +2922,66 @@ ignores hidden links."
\f
;;; Send and receive lists
+(defun org-list--get-text (beg end)
+ "Return text between BEG and END, trimmed, with checkboxes replaced."
+ (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)))
+
+(defun org-list--parse-item (e struct parents prevs)
+ "Return a list containing counter of item, if any, text and any sublist inside it."
+ (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 (org-list--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 (org-list--parse-sublist sub struct parents prevs) 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 (org-list--get-text last-end (or (car children) end))
+ body))))
+ (cons counter (nreverse body)))
+ (list counter (org-list--get-text start end)))))
+
+(defun org-list--parse-sublist (e struct parents prevs)
+ "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 (lambda (x) (org-list--parse-item x struct parents prevs)) e)))
+
(defun org-list-parse-list (&optional delete)
"Parse the list at point and maybe DELETE it.
@@ -2956,77 +3016,10 @@ Point is left at list end."
(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))))))))
+ out)
;; 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)))
+ (setq out (org-list--parse-sublist (org-list-get-all-items top struct prevs) struct parents prevs))
(goto-char top)
(when delete
(delete-region top bottom)
@@ -3109,6 +3102,79 @@ for this list."
"Trim line breaks in a list ITEM."
(setq item (replace-regexp-in-string "\n +" " " item)))
+(defun org-list--export-item (item type depth plist)
+ "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."
+ (let* ((counter (pop item))
+ (istart (plist-get plist :istart))
+ (istart-depth (funcall istart depth))
+ (icount (plist-get plist :icount))
+ (icount-depth (funcall icount depth))
+ (fmt (concat
+ (cond
+ ((eq type 'descriptive)
+ ;; Stick DTSTART to ISTART by
+ ;; left-trimming the latter.
+ (concat (or (and (string-match "[ \t\n\r]+\\'" istart-depth)
+ (replace-match "" t t istart-depth))
+ istart-depth)
+ "%s" (plist-get plist :ddend)))
+ ((and counter (eq type 'ordered))
+ (concat icount-depth "%s"))
+ (t (concat istart-depth "%s")))
+ (plist-get plist :iend)))
+ (first (car item)))
+ ;; Replace checkbox if any is found.
+ (cond
+ ((string-match "\\[CBON\\]" first)
+ (setq first (replace-match (plist-get plist :cbon) t t first)))
+ ((string-match "\\[CBOFF\\]" first)
+ (setq first (replace-match (plist-get plist :cboff) t t first)))
+ ((string-match "\\[CBTRANS\\]" first)
+ (setq first (replace-match (plist-get plist :cbtrans) t t first)))
+ )
+ ;; Replace line breaks if required
+ (when (plist-get plist :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 (plist-get plist :dtstart)
+ term
+ (plist-get plist :dtend)
+ (plist-get plist :ddstart)
+ desc))))
+ (setcar item first)
+ (format fmt
+ (mapconcat (lambda (e)
+ (if (stringp e) e
+ (org-list--export-sublist e (1+ depth) plist)))
+ item (or (plist-get plist :csep) "")))))
+
+(defun org-list--export-sublist (sub depth plist)
+ "Export sublist SUB at DEPTH."
+ (let* ((type (car sub))
+ (items (cdr sub))
+ (fmt (concat (cond
+ ((plist-get plist :splicep) "%s")
+ ((eq type 'ordered)
+ (concat (plist-get plist :ostart) "%s" (plist-get plist :oend)))
+ ((eq type 'descriptive)
+ (concat (plist-get plist :dstart) "%s" (plist-get plist :dend)))
+ (t (concat (plist-get plist :ustart) "%s" (plist-get plist :uend))))
+ (plist-get plist :lsep))))
+ (format fmt (mapconcat (lambda (e)
+ (org-list--export-item e type depth plist))
+ items (or (plist-get plist :isep) "")))))
+
(defun org-list-to-generic (list params)
"Convert a LIST parsed through `org-list-parse-list' to other formats.
Valid parameters PARAMS are:
@@ -3149,94 +3215,7 @@ item, and depth of the current sub-list, starting at 0.
Obviously, `counter' is only available for parameters applying to
items."
(interactive)
- (letrec ((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 (eval istart)))
- (or (and (string-match "[ \t\n\r]+\\'" s)
- (replace-match "" t t s))
- istart))
- "%s" (eval ddend)))
- ((and counter (eq type 'ordered))
- (concat (eval icount) "%s"))
- (t (concat (eval istart) "%s")))
- (eval iend)))
- (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 (eval dtstart) term (eval dtend)
- (eval ddstart) desc))))
- (setcar item first)
- (format fmt
- (mapconcat (lambda (e)
- (if (stringp e) e
- (funcall export-sublist e (1+ depth))))
- item (or (eval csep) ""))))))
- (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) "")))))))
- (concat (funcall export-sublist list 0) "\n")))
+ (concat (org-list--export-sublist list 0 params) "\n"))
(defun org-list-to-latex (list &optional _params)
"Convert LIST into a LaTeX list.
@@ -3259,38 +3238,37 @@ syntax. Return converted list as a string."
(require 'ox-texinfo)
(org-export-string-as list 'texinfo t))
+
+(defun org-list--get-stars (level d)
+ "Return the string for the heading, depending on depth D of
+current sub-list."
+ (let ((oddeven-level (+ level d 1)))
+ (concat (make-string (if org-odd-levels-only
+ (1- (* 2 oddeven-level))
+ oddeven-level)
+ ?*)
+ " ")))
+
(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'."
- (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)
(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)
- ?*)
- " "))))))
+ (org-previous-line-empty-p))))))
(org-list-to-generic
list
(org-combine-plists
- '(:splice t
+ `(: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")
+ :istart (lambda (d) (org-list--get-stars ,level d))
+ :icount (lambda (d) (org-list--get-stars ,level d))
+ :isep (if ,org--blankp "\n\n" "\n")
+ :csep (if ,org--blankp "\n\n" "\n")
:cbon "DONE" :cboff "TODO" :cbtrans "TODO")
params))))
--
2.6.2
next prev parent reply other threads:[~2015-11-06 20:46 UTC|newest]
Thread overview: 12+ messages / expand[flat|nested] mbox.gz Atom feed top
2015-11-06 19:43 Lexical binding bug in org-list.el? Kaushal Modi
2015-11-06 19:47 ` Kaushal Modi
2015-11-06 20:45 ` Aaron Ecay [this message]
2015-11-06 21:13 ` Kaushal Modi
2015-11-07 0:20 ` Nicolas Goaziou
2015-11-07 11:54 ` Aaron Ecay
2015-11-07 16:48 ` Nicolas Goaziou
2015-11-07 21:30 ` Aaron Ecay
2015-11-08 14:57 ` Nicolas Goaziou
2015-11-08 19:55 ` Aaron Ecay
2015-11-09 15:23 ` Kaushal Modi
2015-11-11 9:33 ` Nicolas Goaziou
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87wptuua9n.fsf@gmail.com \
--to=aaronecay@gmail.com \
--cc=emacs-orgmode@gnu.org \
--cc=kaushal.modi@gmail.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).