From mboxrd@z Thu Jan 1 00:00:00 1970 From: Aaron Ecay Subject: Re: Lexical binding bug in org-list.el? Date: Fri, 06 Nov 2015 20:45:56 +0000 Message-ID: <87wptuua9n.fsf@gmail.com> References: Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:37812) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Zuntb-00057u-0O for emacs-orgmode@gnu.org; Fri, 06 Nov 2015 15:46:05 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ZuntW-0004Zu-O5 for emacs-orgmode@gnu.org; Fri, 06 Nov 2015 15:46:02 -0500 Received: from mail-wm0-x229.google.com ([2a00:1450:400c:c09::229]:36948) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZuntW-0004ZQ-EH for emacs-orgmode@gnu.org; Fri, 06 Nov 2015 15:45:58 -0500 Received: by wmll128 with SMTP id l128so50627071wml.0 for ; Fri, 06 Nov 2015 12:45:58 -0800 (PST) In-Reply-To: List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: Kaushal Modi , emacs-org list --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hi Kaushal, I can reproduce the bug, and you=E2=80=99re 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=E2=80=99s 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=E2=80=99s helpful to anyone. Thanks for the report (and the very easy test case! :) ), --=20 Aaron Ecay --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-draft-patch-to-fix-org-list.patch >From d4b3d0e9ec19d6c2bca8a53313c260b266437c00 Mon Sep 17 00:00:00 2001 From: Aaron Ecay 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." ;;; 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 --=-=-=--