diff options
Diffstat (limited to 'lisp/org-list.el')
| -rw-r--r-- | lisp/org-list.el | 573 |
1 files changed, 295 insertions, 278 deletions
diff --git a/lisp/org-list.el b/lisp/org-list.el index a00e557..b23f49b 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1,6 +1,6 @@ ;;; org-list.el --- Plain lists for Org-mode ;; -;; Copyright (C) 2004-2014 Free Software Foundation, Inc. +;; Copyright (C) 2004-2015 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Bastien Guerry <bzg@gnu.org> @@ -88,36 +88,43 @@ (defvar org-closed-string) (defvar org-deadline-string) (defvar org-description-max-indent) -(defvar org-drawers) (defvar org-odd-levels-only) (defvar org-scheduled-string) (defvar org-ts-regexp) (defvar org-ts-regexp-both) +(defvar org-drawer-regexp) -(declare-function outline-invisible-p "outline" (&optional pos)) -(declare-function outline-flag-region "outline" (from to flag)) -(declare-function outline-next-heading "outline" ()) -(declare-function outline-previous-heading "outline" ()) - -(declare-function org-at-heading-p "org" (&optional ignored)) -(declare-function org-before-first-heading-p "org" ()) +(declare-function org-at-heading-p "org" (&optional invisible-ok)) (declare-function org-back-to-heading "org" (&optional invisible-ok)) +(declare-function org-before-first-heading-p "org" ()) (declare-function org-combine-plists "org" (&rest plists)) (declare-function org-count "org" (cl-item cl-seq)) (declare-function org-current-level "org" ()) +(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-context "org-element" (&optional element)) +(declare-function org-element-lineage "org-element" + (blob &optional types with-self)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) +(declare-function org-element-update-syntax "org-element" ()) (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) +(declare-function org-export-string-as "ox" + (string backend &optional body-only ext-plist)) (declare-function org-fix-tags-on-the-fly "org" ()) (declare-function org-get-indentation "org" (&optional line)) (declare-function org-icompleting-read "org" (&rest args)) (declare-function org-in-block-p "org" (names)) (declare-function org-in-regexp "org" (re &optional nlines visually)) +(declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) +(declare-function org-inlinetask-goto-end "org-inlinetask" ()) +(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) +(declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) (declare-function org-level-increment "org" ()) (declare-function org-narrow-to-subtree "org" ()) -(declare-function org-at-heading-p "org" (&optional invisible-ok)) (declare-function org-previous-line-empty-p "org" ()) -(declare-function org-remove-if "org" (predicate seq)) (declare-function org-reduced-level "org" (L)) +(declare-function org-remove-if "org" (predicate seq)) (declare-function org-show-subtree "org" ()) (declare-function org-sort-remove-invisible "org" (S)) (declare-function org-time-string-to-seconds "org" (s)) @@ -125,15 +132,10 @@ (declare-function org-timer-item "org-timer" (&optional arg)) (declare-function org-trim "org" (s)) (declare-function org-uniquify "org" (list)) - -(declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) -(declare-function org-inlinetask-goto-end "org-inlinetask" ()) -(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) -(declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) - -(declare-function org-export-string-as "ox" - (string backend &optional body-only ext-plist)) - +(declare-function outline-flag-region "outline" (from to flag)) +(declare-function outline-invisible-p "outline" (&optional pos)) +(declare-function outline-next-heading "outline" ()) +(declare-function outline-previous-heading "outline" ()) @@ -211,11 +213,19 @@ into (defcustom org-plain-list-ordered-item-terminator t "The character that makes a line with leading number an ordered list item. -Valid values are ?. and ?\). To get both terminators, use t." +Valid values are ?. and ?\). To get both terminators, use t. + +This variable needs to be set before org.el is loaded. If you +need to make a change while Emacs is running, use the customize +interface or run the following code after updating it: + + \\[org-element-update-syntax]" :group 'org-plain-lists :type '(choice (const :tag "dot like in \"2.\"" ?.) (const :tag "paren like in \"2)\"" ?\)) - (const :tag "both" t))) + (const :tag "both" t)) + :set (lambda (var val) (set var val) + (when (featurep 'org-element) (org-element-update-syntax)))) (define-obsolete-variable-alias 'org-alphabetical-lists 'org-list-allow-alphabetical "24.4") ; Since 8.0 @@ -230,13 +240,12 @@ This variable needs to be set before org.el is loaded. If you need to make a change while Emacs is running, use the customize interface or run the following code after updating it: - \(when (featurep 'org-element) (load \"org-element\" t t))" + \\[org-element-update-syntax]" :group 'org-plain-lists :version "24.1" :type 'boolean - :set (lambda (var val) - (when (featurep 'org-element) (load "org-element" t t)) - (set var val))) + :set (lambda (var val) (set var val) + (when (featurep 'org-element) (org-element-update-syntax)))) (defcustom org-list-two-spaces-after-bullet-regexp nil "A regular expression matching bullets that should have 2 spaces after them. @@ -430,9 +439,6 @@ group 4: description tag") (let* ((case-fold-search t) (context (org-list-context)) (lim-up (car context)) - (drawers-re (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$")) (inlinetask-re (and (featurep 'org-inlinetask) (org-inlinetask-outline-regexp))) (item-re (org-item-re)) @@ -476,7 +482,7 @@ group 4: description tag") ((and (looking-at "^[ \t]*#\\+end_") (re-search-backward "^[ \t]*#\\+begin_" lim-up t))) ((and (looking-at "^[ \t]*:END:") - (re-search-backward drawers-re lim-up t)) + (re-search-backward org-drawer-regexp lim-up t)) (beginning-of-line)) ((and inlinetask-re (looking-at inlinetask-re)) (org-inlinetask-goto-beginning) @@ -547,11 +553,7 @@ Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'." (lim-down (or (save-excursion (outline-next-heading)) (point-max)))) ;; Is point inside a drawer? (let ((end-re "^[ \t]*:END:") - ;; Can't use org-drawers-regexp as this function might - ;; be called in buffers not in Org mode. - (beg-re (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$"))) + (beg-re org-drawer-regexp)) (when (save-excursion (and (not (looking-at beg-re)) (not (looking-at end-re)) @@ -635,13 +637,10 @@ Assume point is at an item." (lim-down (nth 1 context)) (text-min-ind 10000) (item-re (org-item-re)) - (drawers-re (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$")) (inlinetask-re (and (featurep 'org-inlinetask) (org-inlinetask-outline-regexp))) (beg-cell (cons (point) (org-get-indentation))) - ind itm-lst itm-lst-2 end-lst end-lst-2 struct + itm-lst itm-lst-2 end-lst end-lst-2 struct (assoc-at-point (function ;; Return association at point. @@ -700,7 +699,7 @@ Assume point is at an item." ((and (looking-at "^[ \t]*#\\+end_") (re-search-backward "^[ \t]*#\\+begin_" lim-up t))) ((and (looking-at "^[ \t]*:END:") - (re-search-backward drawers-re lim-up t)) + (re-search-backward org-drawer-regexp lim-up t)) (beginning-of-line)) ((and inlinetask-re (looking-at inlinetask-re)) (org-inlinetask-goto-beginning) @@ -766,7 +765,7 @@ Assume point is at an item." (cond ((and (looking-at "^[ \t]*#\\+begin_") (re-search-forward "^[ \t]*#\\+end_" lim-down t))) - ((and (looking-at drawers-re) + ((and (looking-at org-drawer-regexp) (re-search-forward "^[ \t]*:END:" lim-down t)))) (forward-line 1)))))) (setq struct (append itm-lst (cdr (nreverse itm-lst-2))) @@ -926,13 +925,13 @@ Value returned is the position of the first child of ITEM." (< ind (org-list-get-ind child-maybe struct))) child-maybe))) -(defun org-list-get-next-item (item struct prevs) +(defun org-list-get-next-item (item _struct prevs) "Return next item in same sub-list as ITEM, or nil. STRUCT is the list structure. PREVS is the alist of previous items, as returned by `org-list-prevs-alist'." (car (rassq item prevs))) -(defun org-list-get-prev-item (item struct prevs) +(defun org-list-get-prev-item (item _struct prevs) "Return previous item in same sub-list as ITEM, or nil. STRUCT is the list structure. PREVS is the alist of previous items, as returned by `org-list-prevs-alist'." @@ -964,7 +963,7 @@ items, as returned by `org-list-prevs-alist'." (push next-item after-item)) (append before-item (list item) (nreverse after-item)))) -(defun org-list-get-children (item struct parents) +(defun org-list-get-children (item _struct parents) "List all children of ITEM, or nil. STRUCT is the list structure. PARENTS is the alist of parents, as returned by `org-list-parents-alist'." @@ -982,7 +981,7 @@ STRUCT is the list structure." (defun org-list-get-bottom-point (struct) "Return point at bottom of list. STRUCT is the list structure." - (apply 'max + (apply #'max (mapcar (lambda (e) (org-list-get-item-end (car e) struct)) struct))) (defun org-list-get-list-begin (item struct prevs) @@ -1137,13 +1136,20 @@ This function modifies STRUCT." ;; Store overlays responsible for visibility status. We ;; also need to store their boundaries as they will be ;; removed from buffer. - (overlays (cons - (mapcar (lambda (ov) - (list ov (overlay-start ov) (overlay-end ov))) - (overlays-in beg-A end-A)) - (mapcar (lambda (ov) - (list ov (overlay-start ov) (overlay-end ov))) - (overlays-in beg-B end-B))))) + (overlays + (cons + (delq nil + (mapcar (lambda (o) + (and (>= (overlay-start o) beg-A) + (<= (overlay-end o) end-A) + (list o (overlay-start o) (overlay-end o)))) + (overlays-in beg-A end-A))) + (delq nil + (mapcar (lambda (o) + (and (>= (overlay-start o) beg-B) + (<= (overlay-end o) end-B) + (list o (overlay-start o) (overlay-end o)))) + (overlays-in beg-B end-B)))))) ;; 1. Move effectively items in buffer. (goto-char beg-A) (delete-region beg-A end-B-no-blank) @@ -1154,42 +1160,39 @@ This function modifies STRUCT." ;; as empty spaces are not moved there. In others words, ;; item BEG-A will end with whitespaces that were at the end ;; of BEG-B and the same applies to BEG-B. - (mapc (lambda (e) - (let ((pos (car e))) - (cond - ((< pos beg-A)) - ((memq pos sub-A) - (let ((end-e (nth 6 e))) - (setcar e (+ pos (- end-B-no-blank end-A-no-blank))) - (setcar (nthcdr 6 e) - (+ end-e (- end-B-no-blank end-A-no-blank))) - (when (= end-e end-A) (setcar (nthcdr 6 e) end-B)))) - ((memq pos sub-B) - (let ((end-e (nth 6 e))) - (setcar e (- (+ pos beg-A) beg-B)) - (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B))) - (when (= end-e end-B) - (setcar (nthcdr 6 e) - (+ beg-A size-B (- end-A end-A-no-blank)))))) - ((< pos beg-B) - (let ((end-e (nth 6 e))) - (setcar e (+ pos (- size-B size-A))) - (setcar (nthcdr 6 e) (+ end-e (- size-B size-A)))))))) - struct) - (setq struct (sort struct (lambda (e1 e2) (< (car e1) (car e2))))) + (dolist (e struct) + (let ((pos (car e))) + (cond + ((< pos beg-A)) + ((memq pos sub-A) + (let ((end-e (nth 6 e))) + (setcar e (+ pos (- end-B-no-blank end-A-no-blank))) + (setcar (nthcdr 6 e) + (+ end-e (- end-B-no-blank end-A-no-blank))) + (when (= end-e end-A) (setcar (nthcdr 6 e) end-B)))) + ((memq pos sub-B) + (let ((end-e (nth 6 e))) + (setcar e (- (+ pos beg-A) beg-B)) + (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B))) + (when (= end-e end-B) + (setcar (nthcdr 6 e) + (+ beg-A size-B (- end-A end-A-no-blank)))))) + ((< pos beg-B) + (let ((end-e (nth 6 e))) + (setcar e (+ pos (- size-B size-A))) + (setcar (nthcdr 6 e) (+ end-e (- size-B size-A)))))))) + (setq struct (sort struct #'car-less-than-car)) ;; Restore visibility status, by moving overlays to their new ;; position. - (mapc (lambda (ov) - (move-overlay - (car ov) - (+ (nth 1 ov) (- (+ beg-B (- size-B size-A)) beg-A)) - (+ (nth 2 ov) (- (+ beg-B (- size-B size-A)) beg-A)))) - (car overlays)) - (mapc (lambda (ov) - (move-overlay (car ov) - (+ (nth 1 ov) (- beg-A beg-B)) - (+ (nth 2 ov) (- beg-A beg-B)))) - (cdr overlays)) + (dolist (ov (car overlays)) + (move-overlay + (car ov) + (+ (nth 1 ov) (- (+ beg-B (- size-B size-A)) beg-A)) + (+ (nth 2 ov) (- (+ beg-B (- size-B size-A)) beg-A)))) + (dolist (ov (cdr overlays)) + (move-overlay (car ov) + (+ (nth 1 ov) (- beg-A beg-B)) + (+ (nth 2 ov) (- beg-A beg-B)))) ;; Return structure. struct))) @@ -1272,12 +1275,16 @@ This function modifies STRUCT." (beforep (progn (looking-at org-list-full-item-re) - ;; Do not count tag in a non-descriptive list. - (<= pos (if (and (match-beginning 4) - (save-match-data - (string-match "[.)]" (match-string 1)))) - (match-beginning 4) - (match-end 0))))) + (<= pos + (cond + ((not (match-beginning 4)) (match-end 0)) + ;; Ignore tag in a non-descriptive list. + ((save-match-data (string-match "[.)]" (match-string 1))) + (match-beginning 4)) + (t (save-excursion + (goto-char (match-end 4)) + (skip-chars-forward " \t") + (point))))))) (split-line-p (org-get-alist-option org-M-RET-may-split-line 'item)) (blank-nb (org-list-separating-blank-lines-number pos struct prevs)) @@ -1473,8 +1480,10 @@ This function returns, destructively, the new list structure." (point-at-eol))))) (t dest))) (org-M-RET-may-split-line nil) - ;; Store visibility. - (visibility (overlays-in item item-end))) + ;; Store inner overlays (to preserve visibility). + (overlays (org-remove-if (lambda (o) (or (< (overlay-start o) item) + (> (overlay-end o) item))) + (overlays-in item item-end)))) (cond ((eq dest 'delete) (org-list-delete-item item struct)) ((eq dest 'kill) @@ -1509,13 +1518,12 @@ This function returns, destructively, the new list structure." new-end (+ end shift))))))) moved-items)) - (lambda (e1 e2) (< (car e1) (car e2)))))) - ;; 2. Restore visibility. - (mapc (lambda (ov) - (move-overlay ov - (+ (overlay-start ov) (- (point) item)) - (+ (overlay-end ov) (- (point) item)))) - visibility) + #'car-less-than-car))) + ;; 2. Restore inner overlays. + (dolist (o overlays) + (move-overlay o + (+ (overlay-start o) (- (point) item)) + (+ (overlay-end o) (- (point) item)))) ;; 3. Eventually delete extra copy of the item and clean marker. (prog1 (org-list-delete-item (marker-position item) struct) (move-marker item nil))) @@ -1630,8 +1638,7 @@ as returned by `org-list-prevs-alist'." ;; Pretend that bullets are uppercase and check if alphabet ;; is sufficient, taking counters into account. (while item - (let ((bul (org-list-get-bullet item struct)) - (count (org-list-get-counter item struct))) + (let ((count (org-list-get-counter item struct))) ;; Virtually determine current bullet (if (and count (string-match "[a-zA-Z]" count)) ;; Counters are not case-sensitive. @@ -1728,7 +1735,7 @@ This function modifies STRUCT." (replace-match "1" nil nil bullet)) ;; Not an ordered list: keep bullet. (t bullet))))))))) - (mapc fix-bul (mapcar 'car struct)))) + (mapc fix-bul (mapcar #'car struct)))) (defun org-list-struct-fix-ind (struct parents &optional bullet-size) "Verify and correct indentation in STRUCT. @@ -1756,7 +1763,7 @@ This function modifies STRUCT." org-list-indent-offset)) ;; If no parent, indent like top-point. (org-list-set-ind item struct top-ind)))))) - (mapc new-ind (mapcar 'car (cdr struct))))) + (mapc new-ind (mapcar #'car (cdr struct))))) (defun org-list-struct-fix-box (struct parents prevs &optional ordered) "Verify and correct checkboxes in STRUCT. @@ -1771,7 +1778,7 @@ break this rule, the function will return the blocking item. In all others cases, the return value will be nil. This function modifies STRUCT." - (let ((all-items (mapcar 'car struct)) + (let ((all-items (mapcar #'car struct)) (set-parent-box (function (lambda (item) @@ -1862,10 +1869,9 @@ Initial position of cursor is restored after the changes." (item-re (org-item-re)) (shift-body-ind (function - ;; Shift the indentation between END and BEG by DELTA. If - ;; MAX-IND is non-nil, ensure that no line will be indented - ;; more than that number. Start from the line before END. - (lambda (end beg delta max-ind) + ;; Shift the indentation between END and BEG by DELTA. + ;; Start from the line before END. + (lambda (end beg delta) (goto-char end) (skip-chars-backward " \r\t\n") (beginning-of-line) @@ -1878,9 +1884,7 @@ Initial position of cursor is restored after the changes." (org-inlinetask-goto-beginning)) ;; Shift only non-empty lines. ((org-looking-at-p "^[ \t]*\\S-") - (let ((i (org-get-indentation))) - (org-indent-line-to - (if max-ind (min (+ i delta) max-ind) (+ i delta)))))) + (org-indent-line-to (+ (org-get-indentation) delta)))) (forward-line -1))))) (modify-item (function @@ -1935,37 +1939,53 @@ Initial position of cursor is restored after the changes." ;; belongs to: it is the last item (ITEM-UP), whose ;; ending is further than the position we're ;; interested in. - (let ((item-up (assoc-default end-pos acc-end '>))) + (let ((item-up (assoc-default end-pos acc-end #'>))) (push (cons end-pos item-up) end-list))) (push (cons end-pos pos) acc-end))) ;; 2. Slice the items into parts that should be shifted by the ;; same amount of indentation. Each slice follow the pattern - ;; (END BEG DELTA MAX-IND-OR-NIL). Slices are returned in - ;; reverse order. - (setq all-ends (sort (append (mapcar 'car itm-shift) - (org-uniquify (mapcar 'car end-list))) - '<)) + ;; (END BEG DELTA). Slices are returned in reverse order. + (setq all-ends (sort (append (mapcar #'car itm-shift) + (org-uniquify (mapcar #'car end-list))) + #'<) + acc-end (nreverse acc-end)) (while (cdr all-ends) (let* ((up (pop all-ends)) (down (car all-ends)) (itemp (assq up struct)) - (item (if itemp up (cdr (assq up end-list)))) - (ind (cdr (assq item itm-shift))) - ;; If we're not at an item, there's a child of the item - ;; point belongs to above. Make sure this slice isn't - ;; moved within that child by specifying a maximum - ;; indentation. - (max-ind (and (not itemp) - (+ (org-list-get-ind item struct) - (length (org-list-get-bullet item struct)) - org-list-indent-offset)))) - (push (list down up ind max-ind) sliced-struct))) + (delta + (if itemp (cdr (assq up itm-shift)) + ;; If we're not at an item, there's a child of the + ;; item point belongs to above. Make sure the less + ;; indented line in this slice has the same column + ;; as that child. + (let* ((child (cdr (assq up acc-end))) + (ind (org-list-get-ind child struct)) + (min-ind most-positive-fixnum)) + (save-excursion + (goto-char up) + (while (< (point) down) + ;; Ignore empty lines. Also ignore blocks and + ;; drawers contents. + (unless (org-looking-at-p "[ \t]*$") + (setq min-ind (min (org-get-indentation) min-ind)) + (cond + ((and (looking-at "#\\+BEGIN\\(:\\|_\\S-+\\)") + (re-search-forward + (format "^[ \t]*#\\+END%s[ \t]*$" + (match-string 1)) + down t))) + ((and (looking-at org-drawer-regexp) + (re-search-forward "^[ \t]*:END:[ \t]*$" + down t))))) + (forward-line))) + (- ind min-ind))))) + (push (list down up delta) sliced-struct))) ;; 3. Shift each slice in buffer, provided delta isn't 0, from ;; end to beginning. Take a special action when beginning is ;; at item bullet. (dolist (e sliced-struct) - (unless (and (zerop (nth 2 e)) (not (nth 3 e))) - (apply shift-body-ind e)) + (unless (zerop (nth 2 e)) (apply shift-body-ind e)) (let* ((beg (nth 1 e)) (cell (assq beg struct))) (unless (or (not cell) (equal cell (assq beg old-struct))) @@ -2061,16 +2081,19 @@ Possible values are: `folded', `children' or `subtree'. See (defun org-list-item-body-column (item) "Return column at which body of ITEM should start." - (let (bpos bcol tpos tcol) - (save-excursion - (goto-char item) - (looking-at "[ \t]*\\(\\S-+\\)\\(.*[ \t]+::\\)?\\([ \t]+\\|$\\)") - (setq bpos (match-beginning 1) tpos (match-end 0) - bcol (progn (goto-char bpos) (current-column)) - tcol (progn (goto-char tpos) (current-column))) - (when (> tcol (+ bcol org-description-max-indent)) - (setq tcol (+ bcol 5)))) - tcol)) + (save-excursion + (goto-char item) + (looking-at "[ \t]*\\(\\S-+\\)\\(.*[ \t]+::\\)?\\([ \t]+\\|$\\)") + (if (match-beginning 2) + (let ((start (1+ (match-end 2))) + (ind (org-get-indentation))) + (if (> start (+ ind org-description-max-indent)) (+ ind 5) start)) + (+ (progn (goto-char (match-end 1)) (current-column)) + (if (and org-list-two-spaces-after-bullet-regexp + (org-string-match-p org-list-two-spaces-after-bullet-regexp + (match-string 1))) + 2 + 1))))) @@ -2326,16 +2349,13 @@ in subtree, ignoring drawers." block-item lim-up lim-down - (drawer-re (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$")) (keyword-re (concat "^[ \t]*\\<\\(" org-scheduled-string "\\|" org-deadline-string "\\|" org-closed-string "\\|" org-clock-string "\\)" " *[[<]\\([^]>]+\\)[]>]")) (orderedp (org-entry-get nil "ORDERED")) - (bounds + (_bounds ;; In a region, start at first item in region. (cond ((org-region-active-p) @@ -2350,7 +2370,8 @@ in subtree, ignoring drawers." ;; time-stamps (scheduled, etc.). (let ((limit (save-excursion (outline-next-heading) (point)))) (forward-line 1) - (while (or (looking-at drawer-re) (looking-at keyword-re)) + (while (or (looking-at org-drawer-regexp) + (looking-at keyword-re)) (if (looking-at keyword-re) (forward-line 1) (re-search-forward "^[ \t]*:END:" limit nil))) @@ -2391,7 +2412,7 @@ in subtree, ignoring drawers." (bottom (copy-marker (org-list-get-bottom-point struct))) (items-to-toggle (org-remove-if (lambda (e) (or (< e lim-up) (> e lim-down))) - (mapcar 'car struct)))) + (mapcar #'car struct)))) (mapc (lambda (e) (org-list-set-checkbox e struct ;; If there is no box at item, leave as-is @@ -2440,130 +2461,123 @@ in subtree, ignoring drawers." (defun org-update-checkbox-count (&optional all) "Update the checkbox statistics in the current section. + This will find all statistic cookies like [57%] and [6/12] and update them with the current numbers. With optional prefix argument ALL, do this for the whole buffer." (interactive "P") - (save-excursion - (let ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") - (box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\(\\[[- X]\\]\\)") + (org-with-wide-buffer + (let* ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") + (box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\ +\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\(\\[[- X]\\]\\)") (recursivep (or (not org-checkbox-hierarchical-statistics) (string-match "\\<recursive\\>" (or (org-entry-get nil "COOKIE_DATA") "")))) - (bounds (if all - (cons (point-min) (point-max)) - (cons (or (ignore-errors (org-back-to-heading t) (point)) - (point-min)) - (save-excursion (outline-next-heading) (point))))) + (within-inlinetask (and (not all) + (featurep 'org-inlinetask) + (org-inlinetask-in-task-p))) + (end (cond (all (point-max)) + (within-inlinetask + (save-excursion (outline-next-heading) (point))) + (t (save-excursion + (org-with-limited-levels (outline-next-heading)) + (point))))) (count-boxes - (function - ;; Return number of checked boxes and boxes of all types - ;; in all structures in STRUCTS. If RECURSIVEP is - ;; non-nil, also count boxes in sub-lists. If ITEM is - ;; nil, count across the whole structure, else count only - ;; across subtree whose ancestor is ITEM. - (lambda (item structs recursivep) - (let ((c-on 0) (c-all 0)) - (mapc - (lambda (s) - (let* ((pre (org-list-prevs-alist s)) - (par (org-list-parents-alist s)) - (items - (cond - ((and recursivep item) (org-list-get-subtree item s)) - (recursivep (mapcar 'car s)) - (item (org-list-get-children item s par)) - (t (org-list-get-all-items - (org-list-get-top-point s) s pre)))) - (cookies (delq nil (mapcar - (lambda (e) - (org-list-get-checkbox e s)) - items)))) - (setq c-all (+ (length cookies) c-all) - c-on (+ (org-count "[X]" cookies) c-on)))) - structs) - (cons c-on c-all))))) - (backup-end 1) - cookies-list structs-bak box-num) - (goto-char (car bounds)) - ;; 1. Build an alist for each cookie found within BOUNDS. The - ;; key will be position at beginning of cookie and values - ;; ending position, format of cookie, and a cell whose car is - ;; number of checked boxes to report, and cdr total number of - ;; boxes. - (while (re-search-forward cookie-re (cdr bounds) t) - (catch 'skip - (save-excursion - (push - (list - (match-beginning 1) ; cookie start - (match-end 1) ; cookie end - (match-string 2) ; percent? - (cond ; boxes count - ;; Cookie is at an heading, but specifically for todo, - ;; not for checkboxes: skip it. - ((and (org-at-heading-p) - (string-match "\\<todo\\>" - (downcase - (or (org-entry-get nil "COOKIE_DATA") "")))) - (throw 'skip nil)) - ;; Cookie is at an heading, but all lists before next - ;; heading already have been read. Use data collected - ;; in STRUCTS-BAK. This should only happen when - ;; heading has more than one cookie on it. - ((and (org-at-heading-p) - (<= (save-excursion (outline-next-heading) (point)) - backup-end)) - (funcall count-boxes nil structs-bak recursivep)) - ;; Cookie is at a fresh heading. Grab structure of - ;; every list containing a checkbox between point and - ;; next headline, and save them in STRUCTS-BAK. - ((org-at-heading-p) - (setq backup-end (save-excursion - (outline-next-heading) (point)) - structs-bak nil) - (while (org-list-search-forward box-re backup-end 'move) - (let* ((struct (org-list-struct)) - (bottom (org-list-get-bottom-point struct))) - (push struct structs-bak) - (goto-char bottom))) - (funcall count-boxes nil structs-bak recursivep)) - ;; Cookie is at an item, and we already have list - ;; structure stored in STRUCTS-BAK. - ((and (org-at-item-p) - (< (point-at-bol) backup-end) - ;; Only lists in no special context are stored. - (not (nth 2 (org-list-context)))) - (funcall count-boxes (point-at-bol) structs-bak recursivep)) - ;; Cookie is at an item, but we need to compute list - ;; structure. - ((org-at-item-p) - (let ((struct (org-list-struct))) - (setq backup-end (org-list-get-bottom-point struct) - structs-bak (list struct))) - (funcall count-boxes (point-at-bol) structs-bak recursivep)) - ;; Else, cookie found is at a wrong place. Skip it. - (t (throw 'skip nil)))) - cookies-list)))) - ;; 2. Apply alist to buffer, in reverse order so positions stay - ;; unchanged after cookie modifications. - (mapc (lambda (cookie) - (let* ((beg (car cookie)) - (end (nth 1 cookie)) - (percentp (nth 2 cookie)) - (checked (car (nth 3 cookie))) - (total (cdr (nth 3 cookie))) - (new (if percentp - (format "[%d%%]" (/ (* 100 checked) - (max 1 total))) - (format "[%d/%d]" checked total)))) - (goto-char beg) - (insert new) - (delete-region (point) (+ (point) (- end beg))) - (when org-auto-align-tags (org-fix-tags-on-the-fly)))) + (lambda (item structs recursivep) + ;; Return number of checked boxes and boxes of all types + ;; in all structures in STRUCTS. If RECURSIVEP is + ;; non-nil, also count boxes in sub-lists. If ITEM is + ;; nil, count across the whole structure, else count only + ;; across subtree whose ancestor is ITEM. + (let ((c-on 0) (c-all 0)) + (dolist (s structs (list c-on c-all)) + (let* ((pre (org-list-prevs-alist s)) + (par (org-list-parents-alist s)) + (items + (cond + ((and recursivep item) (org-list-get-subtree item s)) + (recursivep (mapcar #'car s)) + (item (org-list-get-children item s par)) + (t (org-list-get-all-items + (org-list-get-top-point s) s pre)))) + (cookies (delq nil (mapcar + (lambda (e) + (org-list-get-checkbox e s)) + items)))) + (incf c-all (length cookies)) + (incf c-on (org-count "[X]" cookies))))))) + cookies-list cache) + ;; Move to start. + (cond (all (goto-char (point-min))) + (within-inlinetask (org-back-to-heading t)) + (t (org-with-limited-levels (outline-previous-heading)))) + ;; Build an alist for each cookie found. The key is the position + ;; at beginning of cookie and values ending position, format of + ;; cookie, number of checked boxes to report and total number of + ;; boxes. + (while (re-search-forward cookie-re end t) + (let ((context (save-excursion (backward-char) + (save-match-data (org-element-context))))) + (when (eq (org-element-type context) 'statistics-cookie) + (push + (append + (list (match-beginning 1) (match-end 1) (match-end 2)) + (let* ((container + (org-element-lineage + context + '(drawer center-block dynamic-block inlinetask plain-list + quote-block special-block verse-block))) + (beg (if container (org-element-property :begin container) + (save-excursion + (org-with-limited-levels (outline-previous-heading)) + (point))))) + (or (cdr (assq beg cache)) + (save-excursion + (goto-char beg) + (let ((end + (if container (org-element-property :end container) + (save-excursion + (org-with-limited-levels (outline-next-heading)) + (point)))) + structs) + (while (re-search-forward box-re end t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'item) + (push (org-element-property :structure element) + structs) + (goto-char (org-element-property + :end + (org-element-property :parent + element)))))) + ;; Cache count for cookies applying to the same + ;; area. Then return it. + (let ((count + (funcall count-boxes + (and (eq (org-element-type container) + 'plain-list) + (org-element-property + :contents-begin container)) + structs + recursivep))) + (push (cons beg count) cache) + count)))))) cookies-list)))) + ;; Apply alist to buffer. + (dolist (cookie cookies-list) + (let* ((beg (car cookie)) + (end (nth 1 cookie)) + (percent (nth 2 cookie)) + (checked (nth 3 cookie)) + (total (nth 4 cookie))) + (goto-char beg) + (insert + (if percent (format "[%d%%]" (floor (* 100.0 checked) + (max 1 total))) + (format "[%d/%d]" checked total))) + (delete-region (point) (+ (point) (- end beg))) + (when org-auto-align-tags (org-fix-tags-on-the-fly))))))) (defun org-get-checkbox-statistics-face () "Select the face for checkbox statistics. @@ -2749,6 +2763,7 @@ If a region is active, all items inside will be moved." (t (error "Not at an item"))))) (defvar org-tab-ind-state) +(defvar org-adapt-indentation) (defun org-cycle-item-indentation () "Cycle levels of indentation of an empty item. The first run indents the item, if applicable. Subsequent runs @@ -2940,13 +2955,13 @@ 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 - parse-item ; for byte-compiler (get-text (function ;; Return text between BEG and END, trimmed, with @@ -3056,7 +3071,7 @@ for this list." (unless (org-at-item-p) (error "Not at a list item")) (save-excursion (re-search-backward "#\\+ORGLST" nil t) - (unless (looking-at "#\\+ORGLST:[ \t]+SEND[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)") + (unless (looking-at "\\(?:[ \t]\\)?#\\+ORGLST:[ \t]+SEND[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)") (if maybe (throw 'exit nil) (error "Don't know how to transform this list")))) (let* ((name (match-string 1)) @@ -3072,7 +3087,7 @@ for this list." (re-search-forward (org-item-beginning-re) bottom-point t) (match-beginning 0))) (plain-list (buffer-substring-no-properties top-point bottom-point)) - beg txt) + beg) (unless (fboundp transform) (error "No such transformation function %s" transform)) (let ((txt (funcall transform plain-list))) @@ -3082,7 +3097,8 @@ for this list." (unless (re-search-forward (concat "BEGIN RECEIVE ORGLST +" name - "\\([ \t]\\|$\\)") nil t) + "\\([ \t]\\|$\\)") + nil t) (error "Don't know where to insert translated list")) (goto-char (match-beginning 0)) (beginning-of-line 2) @@ -3195,13 +3211,13 @@ items." (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]+::" first)) + (let* ((complete + (string-match "^\\(.*\\)[ \t]+::[ \t]*" first)) (term (if complete (save-match-data (org-trim (match-string 1 first))) "???")) - (desc (if complete - (org-trim (substring first (match-end 0))) + (desc (if complete (substring first (match-end 0)) first))) (setq first (concat (eval dtstart) term (eval dtend) (eval ddstart) desc)))) @@ -3230,7 +3246,7 @@ items." items (or (eval isep) "")))))))) (concat (funcall export-sublist list 0) "\n"))) -(defun org-list-to-latex (list &optional params) +(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." @@ -3244,7 +3260,7 @@ syntax. Return converted list as a string." (require 'ox-html) (org-export-string-as list 'html t)) -(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." @@ -3255,14 +3271,15 @@ 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))) - (blankp (or (eq rule t) + (org--blankp (or (eq rule t) (and (eq rule 'auto) (save-excursion (outline-previous-heading) (org-previous-line-empty-p))))) - (get-stars + (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. @@ -3277,12 +3294,12 @@ with overruling parameters for `org-list-to-generic'." list (org-combine-plists '(:splice t - :dtstart " " :dtend " " - :istart (funcall get-stars depth) - :icount (funcall get-stars depth) - :isep (if blankp "\n\n" "\n") - :csep (if blankp "\n\n" "\n") - :cbon "DONE" :cboff "TODO" :cbtrans "TODO") + :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") params)))) (provide 'org-list) |