all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
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>


  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

* 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 external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.