tec/org-mode
tec
/
org-mode
forked from mirrors/org-mode
1
0
Fork 0
Code Pull Requests Releases Activity

org-update-parent-todo-statistics: Use parser to match statistics cookie 

* lisp/org.el (org-update-parent-todo-statistics): Ignore text
matching statistics cookie that is inside verbatim environments or
otherwise not detected by parser.  Leave a single exception for
headline properties for backwards compatibility.
This commit is contained in:
Ihor Radchenko 2024-01-29 16:38:07 +01:00
parent 522d7d0afe
commit 22050243b8
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
1 changed files with 48 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

89
lisp/org.el
View File

@ -9779,49 +9779,56 @@ statistics everywhere."
(while (re-search-forward box-re (line-end-position) t)
(setq cnt-all 0 cnt-done 0 cookie-present t)
(setq is-percent (match-end 2) checkbox-beg (match-beginning 0))
(save-match-data
(unless (outline-next-heading) (throw 'exit nil))
(while (and (looking-at org-complex-heading-regexp)
(> (setq l1 (length (match-string 1))) level))
(setq kwd (and (or recursive (= l1 ltoggle))
(match-string 2)))
(if (or (eq org-provide-todo-statistics 'all-headlines)
(and (eq org-provide-todo-statistics t)
(or (member kwd org-done-keywords)))
(and (listp org-provide-todo-statistics)
(stringp (car org-provide-todo-statistics))
(or (member kwd org-provide-todo-statistics)
(member kwd org-done-keywords)))
(and (listp org-provide-todo-statistics)
(listp (car org-provide-todo-statistics))
(or (member kwd (car org-provide-todo-statistics))
(and (member kwd org-done-keywords)
(member kwd (cadr org-provide-todo-statistics))))))
(setq cnt-all (1+ cnt-all))
(and (eq org-provide-todo-statistics t)
kwd
(setq cnt-all (1+ cnt-all))))
(when (or (and (member org-provide-todo-statistics '(t all-headlines))
(member kwd org-done-keywords))
(when (org-element-type-p
(save-excursion
(goto-char checkbox-beg)
(save-match-data (org-element-context)))
'(statistics-cookie
;; Special case - statistics cookie inside properties.
keyword))
(save-match-data
(unless (outline-next-heading) (throw 'exit nil))
(while (and (looking-at org-complex-heading-regexp)
(> (setq l1 (length (match-string 1))) level))
(setq kwd (and (or recursive (= l1 ltoggle))
(match-string 2)))
(if (or (eq org-provide-todo-statistics 'all-headlines)
(and (eq org-provide-todo-statistics t)
(or (member kwd org-done-keywords)))
(and (listp org-provide-todo-statistics)
(stringp (car org-provide-todo-statistics))
(or (member kwd org-provide-todo-statistics)
(member kwd org-done-keywords)))
(and (listp org-provide-todo-statistics)
(listp (car org-provide-todo-statistics))
(member kwd org-done-keywords)
(member kwd (cadr org-provide-todo-statistics)))
(and (listp org-provide-todo-statistics)
(stringp (car org-provide-todo-statistics))
(member kwd org-done-keywords)))
(setq cnt-done (1+ cnt-done)))
(outline-next-heading)))
(setq new
(if is-percent
(format "[%d%%]" (floor (* 100.0 cnt-done)
(max 1 cnt-all)))
(format "[%d/%d]" cnt-done cnt-all))
ndel (- (match-end 0) checkbox-beg))
(goto-char checkbox-beg)
(insert new)
(delete-region (point) (+ (point) ndel))
(when org-auto-align-tags (org-fix-tags-on-the-fly)))
(or (member kwd (car org-provide-todo-statistics))
(and (member kwd org-done-keywords)
(member kwd (cadr org-provide-todo-statistics))))))
(setq cnt-all (1+ cnt-all))
(and (eq org-provide-todo-statistics t)
kwd
(setq cnt-all (1+ cnt-all))))
(when (or (and (member org-provide-todo-statistics '(t all-headlines))
(member kwd org-done-keywords))
(and (listp org-provide-todo-statistics)
(listp (car org-provide-todo-statistics))
(member kwd org-done-keywords)
(member kwd (cadr org-provide-todo-statistics)))
(and (listp org-provide-todo-statistics)
(stringp (car org-provide-todo-statistics))
(member kwd org-done-keywords)))
(setq cnt-done (1+ cnt-done)))
(outline-next-heading)))
(setq new
(if is-percent
(format "[%d%%]" (floor (* 100.0 cnt-done)
(max 1 cnt-all)))
(format "[%d/%d]" cnt-done cnt-all))
ndel (- (match-end 0) checkbox-beg))
(goto-char checkbox-beg)
(insert new)
(delete-region (point) (+ (point) ndel))
(when org-auto-align-tags (org-fix-tags-on-the-fly))))
(when cookie-present
(run-hook-with-args 'org-after-todo-statistics-hook
cnt-done (- cnt-all cnt-done))))))