From: Ihor Radchenko <yantar92@posteo.net>
To: Carlo Tambuatco <oraclmaster@gmail.com>
Cc: Org-Mode Mailing List <emacs-orgmode@gnu.org>
Subject: Re: Org agenda crashes when an agenda's deadline is within 14 days of its scheduled time.
Date: Tue, 19 Sep 2023 10:10:55 +0000 [thread overview]
Message-ID: <8734zaxykw.fsf@localhost> (raw)
In-Reply-To: <CAJb92Ez9gxkTbvxMbJqUT2vuLpXovpqt0Dc_j7FWC=B5fOwFBw@mail.gmail.com>
Carlo Tambuatco <oraclmaster@gmail.com> writes:
> org-version 9.6.9
Then, (1) open agenda as usual, get the error; (2) re-define
`org-agenda-get-scheduled' by evaluating the following snippet (C-M-x
with point inside defun in scratch buffer); (3) open agenda again - you
should not get the error.
(defun org-agenda-get-scheduled (&optional deadlines with-hour)
"Return the scheduled information for agenda display.
Optional argument DEADLINES is a list of deadline items to be
displayed in agenda view. When WITH-HOUR is non-nil, only return
scheduled items with an hour specification like [h]h:mm."
(with-no-warnings (defvar date))
(let* ((props (list 'org-not-done-regexp org-not-done-regexp
'org-todo-regexp org-todo-regexp
'org-complex-heading-regexp org-complex-heading-regexp
'done-face 'org-agenda-done
'mouse-face 'highlight
'help-echo
(format "mouse-2 or RET jump to Org file %s"
(abbreviate-file-name buffer-file-name))))
(regexp (if with-hour
org-scheduled-time-hour-regexp
org-scheduled-time-regexp))
(today (org-today))
(todayp (org-agenda-today-p date)) ; DATE bound by calendar.
(current (calendar-absolute-from-gregorian date))
(deadline-pos
(mapcar (lambda (d)
(let ((m (get-text-property 0 'org-hd-marker d)))
(and m (marker-position m))))
deadlines))
scheduled-items)
(goto-char (point-min))
(if (org-element--cache-active-p)
(org-element-cache-map
(lambda (el)
(when (and (org-element-property :scheduled el)
(or (not with-hour)
(org-element-property
:hour-start
(org-element-property :scheduled el))
(org-element-property
:hour-end
(org-element-property :scheduled el))))
(goto-char (org-element-property :contents-begin el))
(catch :skip
(org-agenda-skip el)
(let* ((s (substring (org-element-property
:raw-value
(org-element-property :scheduled el))
1 -1))
(pos (save-excursion
(goto-char (org-element-property :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))
(donep (eq 'done (org-element-property :todo-type el)))
(sexp? (eq 'diary
(org-element-property
:type (org-element-property :scheduled el))))
;; SCHEDULE is the scheduled date for the entry. It is
;; either the bare date or the last repeat, according
;; to `org-agenda-prefer-last-repeat'.
(schedule
(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 SCHEDULE.
(repeat
(cond
(sexp? schedule)
((<= current today) schedule)
((not org-agenda-show-future-repeats) schedule)
(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 (- current schedule))
(warntime (get-text-property (point) 'org-appt-warntime))
(pastschedp (< schedule today))
(futureschedp (> schedule today))
(habitp (and (fboundp 'org-is-habit-p)
(string= "habit" (org-element-property :STYLE el))))
(suppress-delay
(let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline
(org-element-property
:raw-value
(org-element-property :deadline el)))))
(cond
((not deadline) nil)
;; The current item has a deadline date, so
;; evaluate its delay time.
((integerp org-agenda-skip-scheduled-delay-if-deadline)
;; Use global delay time.
(- org-agenda-skip-scheduled-delay-if-deadline))
((eq org-agenda-skip-scheduled-delay-if-deadline
'post-deadline)
;; Set delay to no later than DEADLINE.
(min (- schedule
(org-agenda--timestamp-to-absolute deadline))
org-scheduled-delay-days))
(t 0))))
(ddays
(cond
;; Nullify delay when a repeater triggered already
;; and the delay is of the form --Xd.
((and (string-match-p "--[0-9]+[hdwmy]" s)
(> schedule (org-agenda--timestamp-to-absolute s)))
0)
(suppress-delay
(let ((org-scheduled-delay-days suppress-delay))
(org-get-wdays s t t)))
(t (org-get-wdays s t)))))
;; Display scheduled items at base date (SCHEDULE), today if
;; scheduled before the current date, and at any repeat past
;; today. However, skip delayed items and items that have
;; been displayed for more than `org-scheduled-past-days'.
(unless (and todayp
habitp
(bound-and-true-p org-habit-show-all-today))
(when (or (and (> ddays 0) (< diff ddays))
(> diff (or (and habitp org-habit-scheduled-past-days)
org-scheduled-past-days))
(> schedule current)
(and (/= current schedule)
(/= current today)
(/= current repeat)))
(throw :skip nil)))
;; Possibly skip done tasks.
(when (and donep
(or org-agenda-skip-scheduled-if-done
(/= schedule current)))
(throw :skip nil))
;; Skip entry if it already appears as a deadline, per
;; `org-agenda-skip-scheduled-if-deadline-is-shown'. This
;; doesn't apply to habits.
(when (pcase org-agenda-skip-scheduled-if-deadline-is-shown
((guard
(or (not (memq (line-beginning-position 0) deadline-pos))
habitp))
nil)
(`repeated-after-deadline
(let ((deadline (time-to-days
(when (org-element-property :deadline el)
(org-time-string-to-time
(org-element-interpret-data
(org-element-property :deadline el)))))))
(and (<= schedule deadline) (> current deadline))))
(`not-today pastschedp)
(`t t)
(_ nil))
(throw :skip nil))
;; Skip habits if `org-habit-show-habits' is nil, or if we
;; only show them for today. Also skip done habits.
(when (and habitp
(or donep
(not (bound-and-true-p org-habit-show-habits))
(and (not todayp)
(bound-and-true-p
org-habit-show-habits-only-for-today))))
(throw :skip nil))
(save-excursion
(goto-char (org-element-property :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))))
(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)))
(level (make-string (org-element-property :level el)
?\s))
(head (save-excursion
(goto-char (org-element-property :begin el))
(re-search-forward org-outline-regexp-bol)
(buffer-substring (point) (line-end-position))))
(time
(cond
;; No time of day designation if it is only a
;; reminder, except for habits, which always show
;; the time of day. Habits are an exception
;; because if there is a time of day, that is
;; interpreted to mean they should usually happen
;; then, even if doing the habit was missed.
((and
(not habitp)
(/= current schedule)
(/= 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
(pcase-let ((`(,first ,past) org-agenda-scheduled-leaders))
;; Show a reminder of a past scheduled today.
(if (and todayp pastschedp)
(format past diff)
first))
(org-add-props head nil
'effort effort
'effort-minutes effort-minutes)
level category tags time nil habitp))
(face (cond ((and (not habitp) pastschedp)
'org-scheduled-previously)
((and habitp futureschedp)
'org-agenda-done)
(todayp 'org-scheduled-today)
(t 'org-scheduled)))
(habitp (and habitp (org-habit-parse-todo (org-element-property :begin el)))))
(org-add-props item props
'undone-face face
'face (if donep 'org-agenda-done face)
'org-marker (org-agenda-new-marker pos)
'org-hd-marker (org-agenda-new-marker (line-beginning-position))
'type (if pastschedp "past-scheduled" "scheduled")
'date (if pastschedp schedule date)
'ts-date schedule
'warntime warntime
'level level
'effort effort 'effort-minutes effort-minutes
'priority (if habitp (org-habit-get-priority habitp)
(+ 99 diff (org-get-priority item)))
'org-habit-p habitp
'todo-state todo-state)
(push item scheduled-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)))
(donep (member todo-state org-done-keywords))
(sexp? (string-prefix-p "%%" s))
;; SCHEDULE is the scheduled date for the entry. It is
;; either the bare date or the last repeat, according
;; to `org-agenda-prefer-last-repeat'.
(schedule
(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 SCHEDULE.
(repeat
(cond
(sexp? schedule)
((<= current today) schedule)
((not org-agenda-show-future-repeats) schedule)
(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 (- current schedule))
(warntime (get-text-property (point) 'org-appt-warntime))
(pastschedp (< schedule today))
(futureschedp (> schedule today))
(habitp (and (fboundp 'org-is-habit-p) (org-is-habit-p)))
(suppress-delay
(let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline
(org-entry-get nil "DEADLINE"))))
(cond
((not deadline) nil)
;; The current item has a deadline date, so
;; evaluate its delay time.
((integerp org-agenda-skip-scheduled-delay-if-deadline)
;; Use global delay time.
(- org-agenda-skip-scheduled-delay-if-deadline))
((eq org-agenda-skip-scheduled-delay-if-deadline
'post-deadline)
;; Set delay to no later than DEADLINE.
(min (- schedule
(org-agenda--timestamp-to-absolute deadline))
org-scheduled-delay-days))
(t 0))))
(ddays
(cond
;; Nullify delay when a repeater triggered already
;; and the delay is of the form --Xd.
((and (string-match-p "--[0-9]+[hdwmy]" s)
(> schedule (org-agenda--timestamp-to-absolute s)))
0)
(suppress-delay
(let ((org-scheduled-delay-days suppress-delay))
(org-get-wdays s t t)))
(t (org-get-wdays s t)))))
;; Display scheduled items at base date (SCHEDULE), today if
;; scheduled before the current date, and at any repeat past
;; today. However, skip delayed items and items that have
;; been displayed for more than `org-scheduled-past-days'.
(unless (and todayp
habitp
(bound-and-true-p org-habit-show-all-today))
(when (or (and (> ddays 0) (< diff ddays))
(> diff (or (and habitp org-habit-scheduled-past-days)
org-scheduled-past-days))
(> schedule current)
(and (/= current schedule)
(/= current today)
(/= current repeat)))
(throw :skip nil)))
;; Possibly skip done tasks.
(when (and donep
(or org-agenda-skip-scheduled-if-done
(/= schedule current)))
(throw :skip nil))
;; Skip entry if it already appears as a deadline, per
;; `org-agenda-skip-scheduled-if-deadline-is-shown'. This
;; doesn't apply to habits.
(when (pcase org-agenda-skip-scheduled-if-deadline-is-shown
((guard
(or (not (memq (line-beginning-position 0) deadline-pos))
habitp))
nil)
(`repeated-after-deadline
(let ((deadline (time-to-days
(org-get-deadline-time (point)))))
(and (<= schedule deadline) (> current deadline))))
(`not-today pastschedp)
(`t t)
(_ nil))
(throw :skip nil))
;; Skip habits if `org-habit-show-habits' is nil, or if we
;; only show them for today. Also skip done habits.
(when (and habitp
(or donep
(not (bound-and-true-p org-habit-show-habits))
(and (not todayp)
(bound-and-true-p
org-habit-show-habits-only-for-today))))
(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))))
(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)))
(level (make-string (org-reduced-level (org-outline-level))
?\s))
(head (buffer-substring (point) (line-end-position)))
(time
(cond
;; No time of day designation if it is only a
;; reminder, except for habits, which always show
;; the time of day. Habits are an exception
;; because if there is a time of day, that is
;; interpreted to mean they should usually happen
;; then, even if doing the habit was missed.
((and
(not habitp)
(/= current schedule)
(/= 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
(pcase-let ((`(,first ,past) org-agenda-scheduled-leaders))
;; Show a reminder of a past scheduled today.
(if (and todayp pastschedp)
(format past diff)
first))
(org-add-props head nil
'effort effort
'effort-minutes effort-minutes)
level category tags time nil habitp))
(face (cond ((and (not habitp) pastschedp)
'org-scheduled-previously)
((and habitp futureschedp)
'org-agenda-done)
(todayp 'org-scheduled-today)
(t 'org-scheduled)))
(habitp (and habitp (org-habit-parse-todo))))
(org-add-props item props
'undone-face face
'face (if donep 'org-agenda-done face)
'org-marker (org-agenda-new-marker pos)
'org-hd-marker (org-agenda-new-marker (line-beginning-position))
'type (if pastschedp "past-scheduled" "scheduled")
'date (if pastschedp schedule date)
'ts-date schedule
'warntime warntime
'level level
'effort effort 'effort-minutes effort-minutes
'priority (if habitp (org-habit-get-priority habitp)
(+ 99 diff (org-get-priority item)))
'org-habit-p habitp
'todo-state todo-state)
(push item scheduled-items)))))))
(nreverse scheduled-items)))
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
next prev parent reply other threads:[~2023-09-19 10:10 UTC|newest]
Thread overview: 8+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-09-19 8:09 Org agenda crashes when an agenda's deadline is within 14 days of its scheduled time Carlo Tambuatco
2023-09-19 9:20 ` Ihor Radchenko
2023-09-19 9:46 ` Carlo Tambuatco
2023-09-19 9:52 ` Ihor Radchenko
2023-09-19 10:03 ` Carlo Tambuatco
2023-09-19 10:10 ` Ihor Radchenko [this message]
2023-09-19 10:17 ` Carlo Tambuatco
2023-09-19 10:52 ` Ihor Radchenko
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=8734zaxykw.fsf@localhost \
--to=yantar92@posteo.net \
--cc=emacs-orgmode@gnu.org \
--cc=oraclmaster@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).