[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/org 06aba04f75 057/101: org-agenda-get-deadlines: Switc
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/org 06aba04f75 057/101: org-agenda-get-deadlines: Switch to org-element API |
|
Date: |
Sat, 1 Jul 2023 09:59:12 -0400 (EDT) |
branch: externals/org
commit 06aba04f751215b513beaa467ea0381881343415
Author: Ihor Radchenko <yantar92@posteo.net>
Commit: Ihor Radchenko <yantar92@posteo.net>
org-agenda-get-deadlines: Switch to org-element API
---
lisp/org-agenda.el | 478 +++++++++++++++++++----------------------------------
1 file changed, 168 insertions(+), 310 deletions(-)
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index e3b9163ad6..0b804a2138 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -6327,317 +6327,175 @@ specification like [h]h:mm."
(today (org-today))
(today? (org-agenda-today-p date)) ; DATE bound by calendar.
(current (calendar-absolute-from-gregorian date))
- deadline-items)
- (goto-char (point-min))
- (if (org-element--cache-active-p)
- (org-element-cache-map
- (lambda (el)
- (when (and (org-element-property :deadline el)
- (or (not with-hour)
- (org-element-property
- :hour-start
- (org-element-property :deadline el))
- (org-element-property
- :hour-end
- (org-element-property :deadline el))))
- (goto-char (org-element-contents-begin el))
- (catch :skip
- (org-agenda-skip el)
- (let* ((s (substring (org-element-property
- :raw-value
- (org-element-property :deadline el))
- 1 -1))
- (pos (save-excursion
- (goto-char (org-element-contents-begin el))
- ;; We intentionally leave NOERROR
- ;; argument in `re-search-forward' nil. If
- ;; the search fails here, something went
- ;; wrong and we are looking at
- ;; non-matching headline.
- (re-search-forward regexp (line-end-position))
- (1- (match-beginning 1))))
- (todo-state (org-element-property :todo-keyword el))
- (done? (eq 'done (org-element-property :todo-type el)))
- (sexp? (eq 'diary
- (org-element-property
- :type (org-element-property :deadline el))))
- ;; DEADLINE is the deadline date for the entry. It is
- ;; either the base date or the last repeat, according
- ;; to `org-agenda-prefer-last-repeat'.
- (deadline
- (cond
- (sexp? (org-agenda--timestamp-to-absolute s current))
- ((or (eq org-agenda-prefer-last-repeat t)
- (member todo-state org-agenda-prefer-last-repeat))
- (org-agenda--timestamp-to-absolute
- s today 'past (current-buffer) pos))
- (t (org-agenda--timestamp-to-absolute s))))
- ;; REPEAT is the future repeat closest from CURRENT,
- ;; according to `org-agenda-show-future-repeats'. If
- ;; the latter is nil, or if the time stamp has no
- ;; repeat part, default to DEADLINE.
- (repeat
+ deadline-items)
+ (org-element-cache-map
+ (lambda (el)
+ (when (and (org-element-property :deadline el)
+ (or (not with-hour)
+ (org-element-property
+ :hour-start
+ (org-element-property :deadline el))
+ (org-element-property
+ :hour-end
+ (org-element-property :deadline el))))
+ (goto-char (org-element-contents-begin el))
+ (catch :skip
+ (org-agenda-skip el)
+ (let* ((s (substring (org-element-property
+ :raw-value
+ (org-element-property :deadline el))
+ 1 -1))
+ (pos (save-excursion
+ (goto-char (org-element-contents-begin el))
+ ;; We intentionally leave NOERROR
+ ;; argument in `re-search-forward' nil. If
+ ;; the search fails here, something went
+ ;; wrong and we are looking at
+ ;; non-matching headline.
+ (re-search-forward regexp (line-end-position))
+ (1- (match-beginning 1))))
+ (todo-state (org-element-property :todo-keyword el))
+ (done? (eq 'done (org-element-property :todo-type el)))
+ (sexp? (eq 'diary
+ (org-element-property
+ :type (org-element-property :deadline el))))
+ ;; DEADLINE is the deadline date for the entry. It is
+ ;; either the base date or the last repeat, according
+ ;; to `org-agenda-prefer-last-repeat'.
+ (deadline
+ (cond
+ (sexp? (org-agenda--timestamp-to-absolute s current))
+ ((or (eq org-agenda-prefer-last-repeat t)
+ (member todo-state org-agenda-prefer-last-repeat))
+ (org-agenda--timestamp-to-absolute
+ s today 'past (current-buffer) pos))
+ (t (org-agenda--timestamp-to-absolute s))))
+ ;; REPEAT is the future repeat closest from CURRENT,
+ ;; according to `org-agenda-show-future-repeats'. If
+ ;; the latter is nil, or if the time stamp has no
+ ;; repeat part, default to DEADLINE.
+ (repeat
+ (cond
+ (sexp? deadline)
+ ((<= current today) deadline)
+ ((not org-agenda-show-future-repeats) deadline)
+ (t
+ (let ((base (if (eq org-agenda-show-future-repeats 'next)
+ (1+ today)
+ current)))
+ (org-agenda--timestamp-to-absolute
+ s base 'future (current-buffer) pos)))))
+ (diff (- deadline current))
+ (suppress-prewarning
+ (let ((scheduled
+ (and org-agenda-skip-deadline-prewarning-if-scheduled
+ (org-element-property
+ :raw-value
+ (org-element-property :scheduled el)))))
+ (cond
+ ((not scheduled) nil)
+ ;; The current item has a scheduled date, so
+ ;; evaluate its prewarning lead time.
+ ((integerp
org-agenda-skip-deadline-prewarning-if-scheduled)
+ ;; Use global prewarning-restart lead time.
+ org-agenda-skip-deadline-prewarning-if-scheduled)
+ ((eq org-agenda-skip-deadline-prewarning-if-scheduled
+ 'pre-scheduled)
+ ;; Set pre-warning to no earlier than SCHEDULED.
+ (min (- deadline
+ (org-agenda--timestamp-to-absolute scheduled))
+ org-deadline-warning-days))
+ ;; Set pre-warning to deadline.
+ (t 0))))
+ (wdays (or suppress-prewarning (org-get-wdays s))))
+ (cond
+ ;; Only display deadlines at their base date, at future
+ ;; repeat occurrences or in today agenda.
+ ((= current deadline) nil)
+ ((= current repeat) nil)
+ ((not today?) (throw :skip nil))
+ ;; Upcoming deadline: display within warning period WDAYS.
+ ((> deadline current) (when (> diff wdays) (throw :skip nil)))
+ ;; Overdue deadline: warn about it for
+ ;; `org-deadline-past-days' duration.
+ (t (when (< org-deadline-past-days (- diff)) (throw :skip nil))))
+ ;; Possibly skip done tasks.
+ (when (and done?
+ (or org-agenda-skip-deadline-if-done
+ (/= deadline current)))
+ (throw :skip nil))
+ (save-excursion
+ (goto-char (org-element-begin el))
+ (let* ((category (org-get-category))
+ (effort (save-match-data (or (get-text-property (point)
'effort)
+ (org-element-property
(intern (concat ":" (upcase org-effort-property))) el))))
+ (effort-minutes (when effort (save-match-data
(org-duration-to-minutes effort))))
+ (level (make-string (org-element-property :level el)
+ ?\s))
+ (head (save-excursion
+ (goto-char (org-element-begin el))
+ (re-search-forward org-outline-regexp-bol)
+ (buffer-substring-no-properties (point)
(line-end-position))))
+ (inherited-tags
+ (or (eq org-agenda-show-inherited-tags 'always)
+ (and (listp org-agenda-show-inherited-tags)
+ (memq 'agenda org-agenda-show-inherited-tags))
+ (and (eq org-agenda-show-inherited-tags t)
+ (or (eq org-agenda-use-tag-inheritance t)
+ (memq 'agenda
+ org-agenda-use-tag-inheritance)))))
+ (tags (org-get-tags el (not inherited-tags)))
+ (time
(cond
- (sexp? deadline)
- ((<= current today) deadline)
- ((not org-agenda-show-future-repeats) deadline)
- (t
- (let ((base (if (eq org-agenda-show-future-repeats
'next)
- (1+ today)
- current)))
- (org-agenda--timestamp-to-absolute
- s base 'future (current-buffer) pos)))))
- (diff (- deadline current))
- (suppress-prewarning
- (let ((scheduled
- (and
org-agenda-skip-deadline-prewarning-if-scheduled
- (org-element-property
- :raw-value
- (org-element-property :scheduled el)))))
- (cond
- ((not scheduled) nil)
- ;; The current item has a scheduled date, so
- ;; evaluate its prewarning lead time.
- ((integerp
org-agenda-skip-deadline-prewarning-if-scheduled)
- ;; Use global prewarning-restart lead time.
- org-agenda-skip-deadline-prewarning-if-scheduled)
- ((eq org-agenda-skip-deadline-prewarning-if-scheduled
- 'pre-scheduled)
- ;; Set pre-warning to no earlier than SCHEDULED.
- (min (- deadline
- (org-agenda--timestamp-to-absolute
scheduled))
- org-deadline-warning-days))
- ;; Set pre-warning to deadline.
- (t 0))))
- (wdays (or suppress-prewarning (org-get-wdays s))))
- (cond
- ;; Only display deadlines at their base date, at future
- ;; repeat occurrences or in today agenda.
- ((= current deadline) nil)
- ((= current repeat) nil)
- ((not today?) (throw :skip nil))
- ;; Upcoming deadline: display within warning period WDAYS.
- ((> deadline current) (when (> diff wdays) (throw :skip nil)))
- ;; Overdue deadline: warn about it for
- ;; `org-deadline-past-days' duration.
- (t (when (< org-deadline-past-days (- diff)) (throw :skip
nil))))
- ;; Possibly skip done tasks.
- (when (and done?
- (or org-agenda-skip-deadline-if-done
- (/= deadline current)))
- (throw :skip nil))
- (save-excursion
- (goto-char (org-element-begin el))
- (let* ((category (org-get-category))
- (effort (save-match-data (or (get-text-property
(point) 'effort)
- (org-element-property
(intern (concat ":" (upcase org-effort-property))) el))))
- (effort-minutes (when effort (save-match-data
(org-duration-to-minutes effort))))
- (level (make-string (org-element-property :level el)
- ?\s))
- (head (save-excursion
- (goto-char (org-element-begin el))
- (re-search-forward org-outline-regexp-bol)
- (buffer-substring-no-properties (point)
(line-end-position))))
- (inherited-tags
- (or (eq org-agenda-show-inherited-tags 'always)
- (and (listp org-agenda-show-inherited-tags)
- (memq 'agenda
org-agenda-show-inherited-tags))
- (and (eq org-agenda-show-inherited-tags t)
- (or (eq org-agenda-use-tag-inheritance t)
- (memq 'agenda
-
org-agenda-use-tag-inheritance)))))
- (tags (org-get-tags el (not inherited-tags)))
- (time
- (cond
- ;; No time of day designation if it is only
- ;; a reminder.
- ((and (/= current deadline) (/= current repeat))
nil)
- ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
- (concat (substring s (match-beginning 1)) " "))
- (t 'time)))
- (item
- (org-agenda-format-item
- ;; Insert appropriate suffixes before deadlines.
- ;; Those only apply to today agenda.
- (pcase-let ((`(,now ,future ,past)
- org-agenda-deadline-leaders))
- (cond
- ((and today? (< deadline today)) (format past (-
diff)))
- ((and today? (> deadline today)) (format future
diff))
- (t now)))
- (org-add-props head nil
- 'effort effort
- 'effort-minutes effort-minutes)
- level category tags time))
- (face (org-agenda-deadline-face
- (- 1 (/ (float diff) (max wdays 1)))))
- (upcoming? (and today? (> deadline today)))
- (warntime (get-text-property (point)
'org-appt-warntime)))
- (org-add-props item props
- 'org-marker (org-agenda-new-marker pos)
- 'org-hd-marker (org-agenda-new-marker
(line-beginning-position))
- 'warntime warntime
- 'level level
- 'effort effort 'effort-minutes effort-minutes
- 'ts-date deadline
- 'urgency
- ;; Adjust urgency to today reminders about deadlines.
- ;; Overdue deadlines get the highest urgency
- ;; increase, then imminent deadlines and eventually
- ;; more distant deadlines.
- (let ((adjust (if today? (- diff) 0)))
- (+ adjust (org-get-priority item)))
- 'priority (org-get-priority item)
- 'todo-state todo-state
- 'type (if upcoming? "upcoming-deadline" "deadline")
- 'date (if upcoming? date deadline)
- 'face (if done? 'org-agenda-done face)
- 'undone-face face
- 'done-face 'org-agenda-done)
- (push item deadline-items)))))))
- :next-re regexp
- :fail-re regexp
- :narrow t)
- (while (re-search-forward regexp nil t)
- (catch :skip
- (unless (save-match-data (org-at-planning-p)) (throw :skip nil))
- (org-agenda-skip)
- (let* ((s (match-string 1))
- (pos (1- (match-beginning 1)))
- (todo-state (save-match-data (org-get-todo-state)))
- (done? (member todo-state org-done-keywords))
- (sexp? (string-prefix-p "%%" s))
- ;; DEADLINE is the deadline date for the entry. It is
- ;; either the base date or the last repeat, according
- ;; to `org-agenda-prefer-last-repeat'.
- (deadline
- (cond
- (sexp? (org-agenda--timestamp-to-absolute s current))
- ((or (eq org-agenda-prefer-last-repeat t)
- (member todo-state org-agenda-prefer-last-repeat))
- (org-agenda--timestamp-to-absolute
- s today 'past (current-buffer) pos))
- (t (org-agenda--timestamp-to-absolute s))))
- ;; REPEAT is the future repeat closest from CURRENT,
- ;; according to `org-agenda-show-future-repeats'. If
- ;; the latter is nil, or if the time stamp has no
- ;; repeat part, default to DEADLINE.
- (repeat
- (cond
- (sexp? deadline)
- ((<= current today) deadline)
- ((not org-agenda-show-future-repeats) deadline)
- (t
- (let ((base (if (eq org-agenda-show-future-repeats 'next)
- (1+ today)
- current)))
- (org-agenda--timestamp-to-absolute
- s base 'future (current-buffer) pos)))))
- (diff (- deadline current))
- (suppress-prewarning
- (let ((scheduled
- (and org-agenda-skip-deadline-prewarning-if-scheduled
- (org-entry-get nil "SCHEDULED"))))
- (cond
- ((not scheduled) nil)
- ;; The current item has a scheduled date, so
- ;; evaluate its prewarning lead time.
- ((integerp
org-agenda-skip-deadline-prewarning-if-scheduled)
- ;; Use global prewarning-restart lead time.
- org-agenda-skip-deadline-prewarning-if-scheduled)
- ((eq org-agenda-skip-deadline-prewarning-if-scheduled
- 'pre-scheduled)
- ;; Set pre-warning to no earlier than SCHEDULED.
- (min (- deadline
- (org-agenda--timestamp-to-absolute scheduled))
- org-deadline-warning-days))
- ;; Set pre-warning to deadline.
- (t 0))))
- (wdays (or suppress-prewarning (org-get-wdays s))))
- (cond
- ;; Only display deadlines at their base date, at future
- ;; repeat occurrences or in today agenda.
- ((= current deadline) nil)
- ((= current repeat) nil)
- ((not today?) (throw :skip nil))
- ;; Upcoming deadline: display within warning period WDAYS.
- ((> deadline current) (when (> diff wdays) (throw :skip nil)))
- ;; Overdue deadline: warn about it for
- ;; `org-deadline-past-days' duration.
- (t (when (< org-deadline-past-days (- diff)) (throw :skip nil))))
- ;; Possibly skip done tasks.
- (when (and done?
- (or org-agenda-skip-deadline-if-done
- (/= deadline current)))
- (throw :skip nil))
- (save-excursion
- (re-search-backward "^\\*+[ \t]+" nil t)
- (goto-char (match-end 0))
- (let* ((category (org-get-category))
- (effort (save-match-data (or (get-text-property (point)
'effort)
- (org-entry-get (point)
org-effort-property))))
- (effort-minutes (when effort (save-match-data
(org-duration-to-minutes effort))))
- (level (make-string (org-reduced-level (org-outline-level))
- ?\s))
- (head (buffer-substring-no-properties
- (point) (line-end-position)))
- (inherited-tags
- (or (eq org-agenda-show-inherited-tags 'always)
- (and (listp org-agenda-show-inherited-tags)
- (memq 'agenda org-agenda-show-inherited-tags))
- (and (eq org-agenda-show-inherited-tags t)
- (or (eq org-agenda-use-tag-inheritance t)
- (memq 'agenda
- org-agenda-use-tag-inheritance)))))
- (tags (org-get-tags nil (not inherited-tags)))
- (time
- (cond
- ;; No time of day designation if it is only
- ;; a reminder.
- ((and (/= current deadline) (/= current repeat)) nil)
- ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
- (concat (substring s (match-beginning 1)) " "))
- (t 'time)))
- (item
- (org-agenda-format-item
- ;; Insert appropriate suffixes before deadlines.
- ;; Those only apply to today agenda.
- (pcase-let ((`(,now ,future ,past)
- org-agenda-deadline-leaders))
- (cond
- ((and today? (< deadline today)) (format past (-
diff)))
- ((and today? (> deadline today)) (format future diff))
- (t now)))
- (org-add-props head nil
- 'effort effort
- 'effort-minutes effort-minutes)
- level category tags time))
- (face (org-agenda-deadline-face
- (- 1 (/ (float diff) (max wdays 1)))))
- (upcoming? (and today? (> deadline today)))
- (warntime (get-text-property (point) 'org-appt-warntime)))
- (org-add-props item props
- 'org-marker (org-agenda-new-marker pos)
- 'org-hd-marker (org-agenda-new-marker
(line-beginning-position))
- 'warntime warntime
- 'level level
- 'effort effort 'effort-minutes effort-minutes
- 'ts-date deadline
- 'urgency
- ;; Adjust urgency to today reminders about deadlines.
- ;; Overdue deadlines get the highest urgency
- ;; increase, then imminent deadlines and eventually
- ;; more distant deadlines.
- (let ((adjust (if today? (- diff) 0)))
- (+ adjust (org-get-priority item)))
- 'priority (org-get-priority item)
- 'todo-state todo-state
- 'type (if upcoming? "upcoming-deadline" "deadline")
- 'date (if upcoming? date deadline)
- 'face (if done? 'org-agenda-done face)
- 'undone-face face
- 'done-face 'org-agenda-done)
- (push item deadline-items)))))))
+ ;; No time of day designation if it is only
+ ;; a reminder.
+ ((and (/= current deadline) (/= current repeat)) nil)
+ ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
+ (concat (substring s (match-beginning 1)) " "))
+ (t 'time)))
+ (item
+ (org-agenda-format-item
+ ;; Insert appropriate suffixes before deadlines.
+ ;; Those only apply to today agenda.
+ (pcase-let ((`(,now ,future ,past)
+ org-agenda-deadline-leaders))
+ (cond
+ ((and today? (< deadline today)) (format past (-
diff)))
+ ((and today? (> deadline today)) (format future
diff))
+ (t now)))
+ (org-add-props head nil
+ 'effort effort
+ 'effort-minutes effort-minutes)
+ level category tags time))
+ (face (org-agenda-deadline-face
+ (- 1 (/ (float diff) (max wdays 1)))))
+ (upcoming? (and today? (> deadline today)))
+ (warntime (get-text-property (point) 'org-appt-warntime)))
+ (org-add-props item props
+ 'org-marker (org-agenda-new-marker pos)
+ 'org-hd-marker (org-agenda-new-marker
(line-beginning-position))
+ 'warntime warntime
+ 'level level
+ 'effort effort 'effort-minutes effort-minutes
+ 'ts-date deadline
+ 'urgency
+ ;; Adjust urgency to today reminders about deadlines.
+ ;; Overdue deadlines get the highest urgency
+ ;; increase, then imminent deadlines and eventually
+ ;; more distant deadlines.
+ (let ((adjust (if today? (- diff) 0)))
+ (+ adjust (org-get-priority item)))
+ 'priority (org-get-priority item)
+ 'todo-state todo-state
+ 'type (if upcoming? "upcoming-deadline" "deadline")
+ 'date (if upcoming? date deadline)
+ 'face (if done? 'org-agenda-done face)
+ 'undone-face face
+ 'done-face 'org-agenda-done)
+ (push item deadline-items)))))))
+ :next-re regexp
+ :fail-re regexp
+ :narrow t)
(nreverse deadline-items)))
(defun org-agenda-deadline-face (fraction)
- [elpa] externals/org 7f337a2b95 098/101: org-fold-core: Fix isearch with `org-fold-core-isearch-open-function', (continued)
- [elpa] externals/org 7f337a2b95 098/101: org-fold-core: Fix isearch with `org-fold-core-isearch-open-function', ELPA Syncer, 2023/07/01
- [elpa] externals/org afbbebff3f 097/101: org-fold-core-get-folding-spec: Respect `org-fold-core-style', ELPA Syncer, 2023/07/01
- [elpa] externals/org 80122a1204 008/101: org-element-ast: New function `org-element-property-2', ELPA Syncer, 2023/07/01
- [elpa] externals/org 5c05ac198a 069/101: testing: Test with and without cache in more cases, ELPA Syncer, 2023/07/01
- [elpa] externals/org f63000cca8 075/101: org-element--current-element: Use "nogroup" versions of regexps, ELPA Syncer, 2023/07/01
- [elpa] externals/org f93d855c51 077/101: Prefer `forward-line' over `beginning-of-line', ELPA Syncer, 2023/07/01
- [elpa] externals/org 924a64da39 013/101: org-element: Use the new org-element-ast library, ELPA Syncer, 2023/07/01
- [elpa] externals/org a7d1dfa171 027/101: Use `org-element-type-p', ELPA Syncer, 2023/07/01
- [elpa] externals/org 607c230d74 041/101: org-with-point-at: Accept syntax node as POM, ELPA Syncer, 2023/07/01
- [elpa] externals/org ec8f359bd6 046/101: org-in-commented-heading-p: Use org-element API, ELPA Syncer, 2023/07/01
- [elpa] externals/org 06aba04f75 057/101: org-agenda-get-deadlines: Switch to org-element API,
ELPA Syncer <=
- [elpa] externals/org 2b96501070 066/101: org-element: Simplify drawer and property drawer regexps, ELPA Syncer, 2023/07/01
- [elpa] externals/org a80efaf460 072/101: org-element-node-property-parser: Remove unnecessary regexp search, ELPA Syncer, 2023/07/01
- [elpa] externals/org 1c7c67b3c6 076/101: org-indent-drawer, org-indent-block: Remove unnecessary checks, ELPA Syncer, 2023/07/01
- [elpa] externals/org 21d3b888c6 087/101: org-element-create: Fix Emacs 28 compatibility, ELPA Syncer, 2023/07/01
- [elpa] externals/org 5a1dd94309 078/101: org-element: Avoid slow `end-of-line', ELPA Syncer, 2023/07/01
- [elpa] externals/org ea401fb1f4 084/101: org-agenda-ignore-properties: Bump :package-version, ELPA Syncer, 2023/07/01
- [elpa] externals/org 5ed3e1dfc3 081/101: org-refresh-category-properties: Do not check element cache, ELPA Syncer, 2023/07/01
- [elpa] externals/org 81e85bda2b 088/101: Fix Emacs 27 compatibility, ELPA Syncer, 2023/07/01
- [elpa] externals/org e18263fceb 091/101: org-element--substring: Fix when buffer is narrowed, ELPA Syncer, 2023/07/01
- [elpa] externals/org 759676b308 092/101: org-fold-core--isearch-show: Do not fully rely on `point', ELPA Syncer, 2023/07/01