>From f5dc1c8c5a439d93162598b25e6744ffee81af3a Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou
Date: Sun, 27 Aug 2017 17:00:27 +0200
Subject: [PATCH] Speed up Agenda generation
* lisp/org-agenda.el (org-agenda--skip-position): New variable.
(org-agenda-log-mode-items): Change default value.
(org-agenda-log-mode): Use new values.
(org-agenda-new-marker): Remove `org-agenda-buffer'
(org-agenda-show-log-scoped): Remove variable.
(org-agenda--file-data):
(org-agenda--clock-data):
(org-agenda--closed-data):
(org-agenda--planning-data):
(org-agenda--state-data):
(org-agenda--timestamp-data):
(org-agenda--diary-data):
(org-agenda--todo-data):
(org-agenda--entry-from-log):
(org-agenda--entry-from-deadline):
(org-agenda--entry-from-diary):
(org-agenda--entry-from-range):
(org-agenda--entry-from-scheduled):
(org-agenda--entry-from-timestamp):
(org-agenda--entry-from-todo): New functions.
(org-agenda-list):
(org-todo-list): Refactor.
(org-diary): Fix docstring. Refactor.
(org-agenda-day-entries): Change signature. Rewrite function.
(org-agenda-entry-get-agenda-timestamp): Change signature. Refactor.
(org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item): Change
signature. Refactor.
(org-agenda-get-todos):
(org-agenda-get-timestamps):
(org-agenda-get-sexps):
(org-agenda-get-progress):
(org-agenda-get-deadlines):
(org-agenda-get-scheduled):
(org-agenda-get-blocks): Remove functions.
(org-agenda-to-appt): Apply changes.
---
lisp/org-agenda.el | 2492 +++++++++++++++++++++++++++-------------------------
lisp/org.el | 2 +-
2 files changed, 1318 insertions(+), 1176 deletions(-)
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index fe7c4f291..9e3f151a3 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -95,15 +95,25 @@
(defvar org-agenda-buffer-name "*Org Agenda*")
(defvar org-agenda-overriding-header nil)
(defvar org-agenda-title-append nil)
+(defvar org-select-this-todo-keyword nil)
+(defvar org-last-arg nil)
+
(with-no-warnings (defvar entry)) ;; unprefixed, from calendar.el
(with-no-warnings (defvar date)) ;; unprefixed, from calendar.el
(defvar original-date) ; dynamically scoped, calendar.el does scope this
(defvar org-agenda-undo-list nil
"List of undoable operations in the agenda since last refresh.")
+
(defvar org-agenda-pending-undo-list nil
"In a series of undo commands, this is the list of remaining undo items.")
+(defvar org-agenda--skip-position nil
+ "Alist specifying skip position per entry category.
+Elements follow the pattern (CATEGORY . POSITION), meaning any
+entry, as returned by `org-agenda--file-data', of CATEGORY (e.g.,
+`todo') located before POSITION should be skipped.")
+
(defcustom org-agenda-confirm-kill 1
"When set, remote killing from the agenda buffer needs confirmation.
When t, a confirmation is always needed. When a number N, confirmation is
@@ -1306,19 +1316,21 @@ for the number of days given here."
:package-version '(Org . "9.1")
:safe 'integerp)
-(defcustom org-agenda-log-mode-items '(closed clock)
+(defcustom org-agenda-log-mode-items '(:closed :clock)
"List of items that should be shown in agenda log mode.
\\\
This list may contain the following symbols:
- closed Show entries that have been closed on that day.
- clock Show entries that have received clocked time on that day.
- state Show all logged state changes.
+ :closed Show entries that have been closed on that day.
+ :clock Show entries that have received clocked time on that day.
+ :state Show all logged state changes.
Note that instead of changing this variable, you can also press \
`\\[universal-argument] \\[org-agenda-log-mode]' in
the agenda to display all available LOG items temporarily."
:group 'org-agenda-daily/weekly
- :type '(set :greedy t (const closed) (const clock) (const state)))
+ :version "26.1"
+ :package-version '(Org . "9.2")
+ :type '(set :greedy t (const :closed) (const :clock) (const :state)))
(defcustom org-agenda-clock-consistency-checks
'(:max-duration "10:00" :min-duration 0 :max-gap "0:05"
@@ -4000,10 +4012,7 @@ Maker is at point, or at POS if non-nil. Org mode keeps a list of
these markers and resets them when they are no longer in use."
(let ((m (copy-marker (or pos (point)) t)))
(setq org-agenda-last-marker-time (float-time))
- (if org-agenda-buffer
- (with-current-buffer org-agenda-buffer
- (push m org-agenda-markers))
- (push m org-agenda-markers))
+ (push m org-agenda-markers)
m))
(defun org-agenda-reset-markers ()
@@ -4067,8 +4076,7 @@ This check for agenda markers in all agenda buffers currently active."
'org-agenda-date-weekend)
(t 'org-agenda-date)))
-(defvar org-agenda-show-log-scoped)
-
+
;;; Agenda Daily/Weekly
(defvar org-agenda-start-day nil ; dynamically scoped parameter
@@ -4077,10 +4085,957 @@ Custom commands can set this variable in the options section.
This is usually a string like \"2007-11-01\", \"+2d\" or any other
input allowed when reading a date through the Org calendar.
See the docstring of `org-read-date' for details.")
+
(defvar org-starting-day nil) ; local variable in the agenda buffer
+
(defvar org-arg-loc nil) ; local variable
+(defvar org-agenda--data-cache (make-hash-table :test #'equal)
+ "Hash table containing currently known agenda data.
+Keys are files' truenames, as returned by `file-truename'.")
+
+(defun org-agenda--file-data (file types)
+ "Return agenda-related data in FILE for TYPES.
+
+FILE is the path to a file to be checked for entries. TYPES are
+symbols indicating which kind of entries should be extracted.
+For details about these, see the documentation of `org-diary'.
+
+Throw an error if FILE doesn't exist or isn't an Org file."
+ (with-current-buffer (if (file-exists-p file)
+ (let ((org-inhibit-startup t))
+ (org-get-agenda-file-buffer file))
+ (error "No such file %S" file))
+ (unless (derived-mode-p 'org-mode)
+ (error "Agenda file %S is not in `org-mode'" file))
+ ;; Cache parsed data. Cache is cleared any time there is
+ ;; a checksum mismatch with the contents of the buffer. Moreover,
+ ;; TODO keywords are the only agenda-related syntax that can
+ ;; change without the buffer being altered. Since checksum cannot
+ ;; help, we need to also check list of TODO keywords.
+ (let* ((key (file-truename file))
+ (cache
+ (let ((store (gethash key org-agenda--data-cache))
+ (checksum (sha1 (current-buffer))))
+ (if (and store
+ (equal checksum (cdr (assq :checksum store))))
+ store
+ ;; Initialize or reset cache.
+ `((:checksum . ,checksum)
+ (:todo-regexp . ,org-todo-regexp)))))
+ (results nil))
+ (save-excursion
+ (save-restriction
+ (if (eq (current-buffer) org-agenda-restrict)
+ (narrow-to-region org-agenda-restrict-begin
+ org-agenda-restrict-end)
+ (widen))
+ ;; Group planning types into the same category since they
+ ;; are extracted with a common function.
+ (dolist (type (delete-dups
+ (mapcar (lambda (type)
+ (if (memq type
+ '(:deadline :deadline* :scheduled
+ :scheduled*))
+ :planning
+ type))
+ types)))
+ (pcase (assq type cache)
+ (`(,(pred (eq type)) . ,data) ;cached data spotted
+ (let ((todo-info (assq :todo-regexp cache)))
+ (when (and (eq type :todo)
+ (not (equal org-todo-regexp (cdr todo-info))))
+ ;; TODO keywords changed: we must refresh cache.
+ (setq data (org-agenda--todo-data))
+ (setcdr (assq :todo cache) data)
+ (setcdr todo-info org-todo-regexp)))
+ (setq results (append data results)))
+ (_
+ (org-with-point-at 1
+ (let ((data
+ (if (eq type :sexp) (org-agenda--diary-data)
+ ;; Skip contents before first headline,
+ ;; since there would be no entry to display.
+ (when (re-search-forward org-outline-regexp-bol nil t)
+ (beginning-of-line)
+ (pcase type
+ (`:clock (org-agenda--clock-data))
+ (`:closed (org-agenda--closed-data))
+ (`:planning (org-agenda--planning-data))
+ (`:state (org-agenda--state-data))
+ (`:timestamp (org-agenda--timestamp-data))
+ (`:todo (org-agenda--todo-data))
+ (_ (error "Unknown entry type: %S" type)))))))
+ (push (cons type data) cache)
+ (puthash key cache org-agenda--data-cache)
+ (setq results (append data results)))))))))
+ (sort results #'car-less-than-car))))
+
+(defun org-agenda--clock-data ()
+ "Extract log data from current buffer, starting from point.
+Return a list of (POSITION clock TIMESTAMP DURATION) elements.
+POSITION is the beginning of the datum. TIMESTAMP is the
+associated time-stamp. DURATION is the clock duration as
+a string."
+ (let ((result nil))
+ (org-with-wide-buffer
+ (while (re-search-forward org-clock-line-re nil t)
+ (let ((element (org-element-at-point)))
+ (when (eq 'clock (org-element-type element))
+ (let ((timestamp (progn
+ (skip-chars-forward " \t")
+ (and (looking-at org-tsr-regexp-both)
+ (match-string 0)))))
+ (when timestamp
+ (push (list (line-beginning-position)
+ 'clock
+ timestamp
+ (org-element-property :duration element))
+ result)))))))
+ result))
+
+(defun org-agenda--closed-data ()
+ "Extract log data from current buffer, starting from point.
+Return a list of (POSITION closed TIMESTAMP nil) elements.
+POSITION is the beginning of the datum. TIMESTAMP is the
+associated time-stamp."
+ (let ((result nil))
+ (org-with-wide-buffer
+ (while (re-search-forward org-closed-string nil t)
+ (catch :next
+ (when (org-at-planning-p)
+ (let ((timestamp (progn
+ (skip-chars-forward " \t")
+ (and (looking-at org-tsr-regexp-both)
+ (match-string 0)))))
+ (when timestamp
+ (push (list (line-beginning-position) 'closed timestamp nil)
+ result)))))))
+ result))
+
+(defun org-agenda--planning-data ()
+ "Extract planning data from current buffer, starting from point.
+Return a list of (POSITION TYPE TIMESTAMP) elements. POSITION is
+the beginning of the planning line. TYPE is a symbol among
+`deadline' and `scheduled'. TIMESTAMP is the associated
+time-stamp, as a string."
+ (let ((result nil))
+ (org-with-wide-buffer
+ (while (re-search-forward org-planning-line-re nil t)
+ (when (org-at-planning-p)
+ (save-excursion
+ (beginning-of-line)
+ (let ((end (line-end-position)))
+ (save-excursion
+ (when (re-search-forward org-deadline-time-regexp end t)
+ (push (list (line-beginning-position)
+ 'deadline
+ (match-string 1))
+ result)))
+ (save-excursion
+ (when (re-search-forward org-scheduled-time-regexp end t)
+ (push (list (line-beginning-position)
+ 'scheduled
+ (match-string 1))
+ result))))))))
+ result))
+
+(defun org-agenda--state-data ()
+ "Extract log data from current buffer, starting from point.
+Return a list of (POSITION state nil STATE) elements. POSITION
+is the beginning of the datum. STATE is the TODO state as
+a string."
+ (let ((result nil))
+ (org-with-wide-buffer
+ (while (re-search-forward "^[ \t]*- State \"\\([a-zA-Z0-9]+\\)\"" nil t)
+ (catch :next
+ (let* ((state (match-string 1)))
+ (push (list (line-beginning-position) 'state nil state)
+ result)))))
+ result))
+
+(defun org-agenda--timestamp-data ()
+ "Extract plain timestamp data from current buffer, starting from point.
+Return a list of (POSITION TYPE START END) elements. POSITION is
+the beginning position of the first timestamp. TYPE is either
+`range' or `timestamp'. START is the first timestamp. END is
+the last one for `range' type or nil."
+ (let ((regexp (concat org-ts-regexp "\\|" "<%%\\(([^>\n]+)\\)>"))
+ (result nil))
+ (org-with-wide-buffer
+ (while (re-search-forward regexp nil t)
+ (unless (save-match-data (org-at-planning-p))
+ (let ((pos (match-beginning 0)))
+ ;; Distinguish between plain time-stamps and time-stamp
+ ;; ranges. In the second case, move after the whole match
+ ;; to avoid re-matching second time-stamp.
+ (goto-char (match-beginning 0))
+ (push (if (and (looking-at org-tsr-regexp)
+ (match-end 3))
+ (list pos 'range (match-string 1) (match-string 3))
+ (list pos 'timestamp (match-string 0) nil))
+ result)
+ (goto-char (match-end 0))))))
+ result))
+
+(defun org-agenda--diary-data ()
+ "Extract S-exp diary data from current buffer, starting from point.
+Return a list of (POSITION diary SEXP TEXT) elements. POSITION
+is the beginning position of the diary entry. SEXP is the diary
+S-exp, as a string. TEXT is the text following the S-exp, as
+a string."
+ (let ((result nil))
+ (org-with-wide-buffer
+ (while (re-search-forward "^%%(" nil t)
+ (forward-char -1)
+ (let ((start (point))
+ (pos (line-beginning-position)))
+ (forward-sexp)
+ (let ((sexp (buffer-substring start (point)))
+ (text (progn (looking-at ".*$")
+ (org-trim (match-string 0)))))
+ (push (list pos 'diary sexp text) result)))))
+ result))
+
+(defun org-agenda--todo-data ()
+ "Extract TODO data from current buffer, starting from point.
+Return a list of (POSITION todo TODO) elements. POSITION is the
+beginning position of the headline. TODO is its keyword."
+ (let ((regexp (format "^\\*+ +\\(%s\\)" org-todo-regexp))
+ (result nil))
+ (org-with-wide-buffer
+ (while (let ((case-fold-search nil)) (re-search-forward regexp nil t))
+ (push (list (line-beginning-position)
+ 'todo
+ (match-string 1)
+ (buffer-substring (match-beginning 1) (line-end-position)))
+ result)))
+ result))
+
+(defun org-agenda--entry-from-log (date datum)
+ "Return agenda entry for DATE associated to log data.
+
+DATE is a list of the form (MONTH DAY YEAR). DATUM is a list of
+the form (POS TYPE TIMESTAMP EXTRA). POS is the location of the
+log data. TYPE is `clock', `closed' or `state'. TIMESTAMP the
+clock or closed timestamp, or nil. EXTRA is the TODO state,
+a clock duration, or nil.
+
+Throw `:skip' if no entry is associated to DATUM at DATE. Leave
+point past entries that should be ignored."
+ (pcase-let* ((`(,pos ,type ,timestamp ,extra) datum)
+ (org-agenda-search-headline-for-time nil))
+ (goto-char pos)
+ (org-agenda-skip)
+ (let ((notes
+ (cond ((not org-agenda-log-mode-add-notes) nil)
+ ((eq type 'state)
+ (and (looking-at ".*\\\\\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$")
+ (match-string 1)))
+ ((eq type 'clock)
+ (and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$")
+ (match-string 1)))
+ (t nil))))
+ (save-excursion
+ (re-search-backward "^\\*+[ \t]+" nil t)
+ (goto-char (match-end 0))
+ (let* ((marker (org-agenda-new-marker pos))
+ (hdmarker (org-agenda-new-marker (line-beginning-position)))
+ (category (org-get-category))
+ (level (make-string (org-reduced-level (org-outline-level))
+ ?\s))
+ (inherited-tags
+ (or (eq org-agenda-show-inherited-tags 'always)
+ (and (listp org-agenda-show-inherited-tags)
+ (memq 'todo org-agenda-show-inherited-tags))
+ (and (eq org-agenda-show-inherited-tags t)
+ (or (eq org-agenda-use-tag-inheritance t)
+ (memq 'todo org-agenda-use-tag-inheritance)))))
+ (tags (org-get-tags-at nil (not inherited-tags)))
+ (headline (buffer-substring (point) (line-end-position)))
+ (item
+ (org-agenda-format-item
+ (pcase type
+ (`closed "Closed: ")
+ (`state (format "State: (%s)" extra))
+ (_ (format "Clocked: (%s)" (or extra "-"))))
+ (cond
+ ((not notes) headline)
+ ((string-match "[ \t]+\\(:[^ \n\t]*?:\\)[ \t]*$" headline)
+ (replace-match (format " - %s \\1" notes) nil nil headline 1))
+ (t (concat headline " - " notes)))
+ level category tags timestamp)))
+ (org-add-props item nil
+ 'date date
+ 'done-face 'org-agenda-done
+ 'face 'org-agenda-done
+ 'help-echo (format "mouse-2 or RET jump to Org file %S"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer))))
+ 'level level
+ 'mouse-face 'highlight
+ 'org-complex-heading-regexp org-complex-heading-regexp
+ 'org-hd-marker hdmarker
+ 'org-marker marker
+ 'org-not-done-regexp org-not-done-regexp
+ 'org-todo-regexp org-todo-regexp
+ 'priority 100000
+ 'type "closed"
+ 'undone-face 'org-warning))))))
+
+(defun org-agenda--entry-from-deadline (date datum with-hour)
+ "Return agenda entry for DATE associated to a deadline.
+
+DATE is a list of the form (MONTH DAY YEAR). DATUM is a list of
+the form (POS deadline TIMESTAMP) where POS is the location of
+deadline and TIMESTAMP the deadline's timestamp.
+
+When WITH-HOUR is non-nil, only return deadlines with an hour
+specification like [h]h:mm.
+
+Throw `:skip' if no entry is associated to DATUM at DATE. Leave
+point past entries that should be ignored."
+ (pcase-let
+ ((`(,pos ,_ ,base) datum)
+ (current (calendar-absolute-from-gregorian date)))
+ (goto-char pos)
+ ;; Remove deadlines without an hour if WITH-HOUR is non-nil.
+ (when (and with-hour
+ (not
+ (string-match-p "[0-9][0-9]?:[0-9][0-9]?[-0-9+:hdwmy \t.]*\\'"
+ base)))
+ (throw :skip nil))
+ (org-agenda-skip)
+ (let* ((sexp? (string-prefix-p "%%" base))
+ (today (org-today))
+ (today? (org-agenda-today-p date))
+ (todo-state (org-get-todo-state))
+ (done? (member todo-state org-done-keywords))
+ ;; 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 base current))
+ ((or (eq org-agenda-prefer-last-repeat t)
+ (member todo-state org-agenda-prefer-last-repeat))
+ (org-agenda--timestamp-to-absolute
+ base today 'past (current-buffer) pos))
+ (t (org-agenda--timestamp-to-absolute base))))
+ ;; 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 ((next (if (eq org-agenda-show-future-repeats 'next)
+ (1+ today)
+ current)))
+ (org-agenda--timestamp-to-absolute
+ base next '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 (if suppress-prewarning
+ (let ((org-deadline-warning-days suppress-prewarning))
+ (org-get-wdays base))
+ (org-get-wdays base))))
+ (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))
+ (level (make-string (org-reduced-level (org-outline-level))
+ ?\s))
+ (head (buffer-substring (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-at 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]\\)" base)
+ (concat (substring base (match-beginning 1)) " "))
+ (t 'time)))
+ (item
+ (org-agenda-format-item
+ ;; Insert appropriate suffixes before deadlines.
+ ;; Those only apply to today agenda.
+ (pcase-let ((`(,now ,next ,past) org-agenda-deadline-leaders))
+ (cond
+ ((and today? (< deadline today)) (format past (- diff)))
+ ((and today? (> deadline today)) (format next diff))
+ (t now)))
+ head 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 nil
+ 'date (if upcoming? date deadline)
+ 'done-face 'org-agenda-done
+ 'face (if done? 'org-agenda-done face)
+ 'help-echo (format "mouse-2 or RET jump to Org file %S"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer))))
+ 'level level
+ 'mouse-face 'highlight
+ 'org-complex-heading-regexp org-complex-heading-regexp
+ 'org-hd-marker (org-agenda-new-marker (line-beginning-position))
+ 'org-marker (org-agenda-new-marker pos)
+ 'org-not-done-regexp org-not-done-regexp
+ 'org-todo-regexp org-todo-regexp
+ ;; Adjust priority to today reminders about deadlines.
+ ;; Overdue deadlines get the highest priority increase,
+ ;; then imminent deadlines and eventually more distant
+ ;; deadlines.
+ 'priority (let ((adjust (if today? (- diff) 0)))
+ (+ adjust (org-get-priority item)))
+ 'todo-state todo-state
+ 'ts-date deadline
+ 'type (if upcoming? "upcoming-deadline" "deadline")
+ 'undone-face face
+ 'warntime warntime))))))
+
+(defun org-agenda--entry-from-diary (date datum)
+ "Return diary entries for DATE associated to a diary S-exp entry.
+
+DATE is a list of the form (MONTH DAY YEAR). DATUM is a list of
+the form (POS diary SEXP TEXT) where POS is the location of
+strings SEXP and TEXT.
+
+Throw `:skip' if no entry is associated to DATUM at DATE. Return
+a list of strings. Leave point past entries that should be
+ignored."
+ (require 'diary-lib)
+ (pcase-let* ((`(,pos ,_ ,sexp ,text) datum)
+ (result (org-diary-sexp-entry sexp text date)))
+ (goto-char pos)
+ (unless result (throw :skip nil))
+ (let* ((category (org-get-category))
+ (marker (org-agenda-new-marker))
+ (level (make-string (org-reduced-level (org-outline-level))
+ ?\s))
+ (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-at nil (not inherited-tags)))
+ (todo-state (org-get-todo-state))
+ (warntime (get-text-property (point) 'org-appt-warntime))
+ (extra nil)
+ (entries nil))
+ (dolist (entry (if (stringp result) (list result) result))
+ (when (and org-agenda-diary-sexp-prefix
+ (string-match org-agenda-diary-sexp-prefix entry))
+ (setq extra (match-string 0 entry))
+ (setq entry (replace-match "" nil nil entry)))
+ (let* ((text (or (org-string-nw-p entry)
+ "SEXP entry returned empty string"))
+ (item (org-agenda-format-item
+ extra text level category tags 'time)))
+ (push (org-add-props item nil
+ 'date date
+ 'face 'org-agenda-calendar-sexp
+ 'help-echo (format "mouse-2 or RET jump to Org file %S"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer))))
+ 'level level
+ 'mouse-face 'highlight
+ 'org-marker marker
+ 'todo-state todo-state
+ 'type "sexp"
+ 'warntime warntime)
+ entries)))
+ entries)))
+
+(defun org-agenda--entry-from-range (date data)
+ "Return agenda entry for DATE associated to a time-stamp range.
+
+DATE is a list of the form (MONTH DAY YEAR). DATA is list of the
+form (POS range START END) where POS is the location of the
+time-stamp range, START and END are, respectively, the beginning
+and the end of the range, as strings. POS is the location of the
+time-stamp in the current buffer.
+
+Throw `:skip' if no entry is associated to DATA at DATE. Leave
+point past entries that should be ignored."
+ (pcase-let* ((`(,pos ,_ ,start-stamp ,end-stamp) data)
+ (current (calendar-absolute-from-gregorian date))
+ (start (org-agenda--timestamp-to-absolute
+ start-stamp nil nil (current-buffer) pos))
+ (end (org-agenda--timestamp-to-absolute
+ end-stamp nil nil (current-buffer) pos))
+ (todo-state nil))
+ (goto-char pos)
+ (when (or (< current start) (> current end))
+ ;; DATE is outside the range.
+ (throw :skip nil))
+ (setq todo-state (org-get-todo-state))
+ (when (and org-agenda-skip-timestamp-if-done
+ (member todo-state org-done-keywords))
+ (throw :skip nil))
+ (org-agenda-skip)
+ (save-excursion
+ (re-search-backward org-outline-regexp-bol nil t)
+ ;; Format entry as a return value.
+ (let* ((category (org-get-category pos))
+ (head (progn (looking-at "\\*+[ \t]+\\(.*\\)")
+ (match-string 1)))
+ (remove-re (and org-agenda-remove-timeranges-from-blocks
+ (format "<%s.*?>--<%s.*?>"
+ (regexp-quote start-stamp)
+ (regexp-quote end-stamp))))
+ (marker (org-agenda-new-marker pos))
+ (hdmarker (org-agenda-new-marker (point)))
+ (category (org-get-category))
+ (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-at nil (not inherited-tags)))
+ (level (make-string (org-reduced-level (org-outline-level))
+ ?\s))
+ (item (org-agenda-format-item
+ (format (nth (if (= start end) 0 1)
+ org-agenda-timerange-leaders)
+ (1+ (- current start))
+ (1+ (- end start)))
+ head level category tags
+ (cond ((and (= start current) (= end current))
+ (format "<%s>--<%s>" start-stamp end-stamp))
+ ((= start current) (format "<%s>" start-stamp))
+ ((= end current) (format "<%s>" end-stamp)))
+ remove-re)))
+ (org-add-props item nil
+ 'date date
+ 'face nil
+ 'help-echo (format "mouse-2 or RET jump to Org file %S"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer))))
+ 'level level
+ 'mouse-face 'highlight
+ 'org-complex-heading-regexp org-complex-heading-regexp
+ 'org-marker marker 'org-hd-marker hdmarker
+ 'org-not-done-regexp org-not-done-regexp
+ 'org-todo-regexp org-todo-regexp
+ 'priority (org-get-priority item)
+ 'todo-state todo-state
+ 'type "block")))))
+
+(defun org-agenda--entry-from-scheduled (date datum deadlines with-hour)
+ "Return agenda entry for DATE associated to a schedule.
+
+DATE is a list of the form (MONTH DAY YEAR). DATUM is a list of
+the form (POS scheduled TIMESTAMP) where POS is the location of
+schedule and TIMESTAMP the schedule's timestamp. DEADLINES is
+a list of positions for deadlines displayed in the agenda. When
+WITH-HOUR is non-nil, only return schedules with an hour
+specification like [h]h:mm.
+
+Throw `:skip' if no entry is associated to DATUM at DATE. Leave
+point past entries that should be ignored."
+ (pcase-let* ((`(,pos ,_ ,base) datum)
+ (today (org-today))
+ (current (calendar-absolute-from-gregorian date))
+ (today? (org-agenda-today-p date)))
+ (goto-char pos)
+ (when (and with-hour
+ (not
+ (string-match-p "[0-9][0-9]?:[0-9][0-9]?[-0-9+:hdwmy \t.]*\\'"
+ base)))
+ (throw :skip nil))
+ (org-agenda-skip)
+ (let* ((sexp? (string-prefix-p "%%" base))
+ (todo-state (save-match-data (org-get-todo-state)))
+ (done? (member todo-state org-done-keywords))
+ ;; 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 base current))
+ ((or (eq org-agenda-prefer-last-repeat t)
+ (member todo-state org-agenda-prefer-last-repeat))
+ (org-agenda--timestamp-to-absolute
+ base today 'past (current-buffer) pos))
+ (t (org-agenda--timestamp-to-absolute base))))
+ ;; 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 ((next (if (eq org-agenda-show-future-repeats 'next)
+ (1+ today)
+ current)))
+ (org-agenda--timestamp-to-absolute
+ base next 'future (current-buffer) pos)))))
+ (diff (- current schedule))
+ (warntime (get-text-property (point) 'org-appt-warntime))
+ (pastschedp (< schedule today))
+ (habit? (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]" base)
+ (> current schedule))
+ 0)
+ (suppress-delay
+ (let ((org-scheduled-delay-days suppress-delay))
+ (org-get-wdays base t t)))
+ (t (org-get-wdays base 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 today?
+ habit?
+ (bound-and-true-p org-habit-show-all-today))
+ (when (or (and (> ddays 0) (< diff ddays))
+ (> diff org-scheduled-past-days)
+ (> schedule current)
+ (and (/= current schedule)
+ (/= current today)
+ (/= current repeat)))
+ (throw :skip nil)))
+ ;; Possibly skip DONE tasks.
+ (when (and done?
+ (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 habit?
+ (not (memq (line-beginning-position 0) deadlines))))
+ 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 habit?
+ (or done?
+ (not (bound-and-true-p org-habit-show-habits))
+ (and (not today?)
+ (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))
+ (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-at 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.
+ ((and (/= current schedule) (/= current repeat)) nil)
+ ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" base)
+ (concat (substring base (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 today? pastschedp)
+ (format past diff)
+ first))
+ head level category tags time nil habit?))
+ (face (cond ((and (not habit?) pastschedp)
+ 'org-scheduled-previously)
+ (today? 'org-scheduled-today)
+ (t 'org-scheduled)))
+ (habit? (and habit? (org-habit-parse-todo))))
+ (org-add-props item nil
+ 'date (if pastschedp schedule date)
+ 'done-face 'org-agenda-done
+ 'face (if done? 'org-agenda-done face)
+ 'help-echo (format "mouse-2 or RET jump to Org file %S"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer))))
+ 'level level
+ 'mouse-face 'highlight
+ 'org-complex-heading-regexp org-complex-heading-regexp
+ 'org-habit-p habit?
+ 'org-hd-marker (org-agenda-new-marker (line-beginning-position))
+ 'org-marker (org-agenda-new-marker pos)
+ 'org-not-done-regexp org-not-done-regexp
+ 'org-todo-regexp org-todo-regexp
+ 'priority (if habit? (org-habit-get-priority habit?)
+ (+ 99 diff (org-get-priority item)))
+ 'todo-state todo-state
+ 'ts-date schedule
+ 'type (if pastschedp "past-scheduled" "scheduled")
+ 'undone-face face
+ 'warntime warntime))))))
+
+(defun org-agenda--entry-from-timestamp (date datum deadlines)
+ "Return agenda entry for DATE associated to a time-stamp.
+
+DATE is a list of the form (MONTH DAY YEAR). DATUM is a list of
+the form (POS timestamp TIMESTAMP) where POS is the location of
+string TIMESTAMP, a time-stamp. DEADLINES is a list of positions
+for deadlines displayed in the agenda.
+
+Throw `:skip' if no entry is associated to DATUM at DATE. Leave
+point past entries that should be ignored."
+ (pcase-let ((`(,pos ,_ ,time-stamp) datum))
+ (goto-char pos)
+ (org-agenda-skip)
+ (let ((current (calendar-absolute-from-gregorian date))
+ (todo-state (org-get-todo-state)))
+ (cond
+ ((and org-agenda-skip-timestamp-if-done
+ (member todo-state org-done-keywords))
+ ;; Possibly skip DONE tasks.
+ (throw :skip nil))
+ ((string-prefix-p "<%%" time-stamp) ;S-exp timestamp
+ (unless (org-diary-sexp-entry time-stamp "" date)
+ ;; S-exp entry doesn't match current day: skip it.
+ (throw :skip nil)))
+ ((org-get-repeat time-stamp) ;time-stamp with a repeater
+ (let* ((today (org-today))
+ (past
+ ;; A repeating time stamp is shown at its base date
+ ;; and every repeated date up to TODAY. If
+ ;; `org-agenda-prefer-last-repeat' is non-nil,
+ ;; however, only the last repeat before today
+ ;; (inclusive) is shown.
+ (org-agenda--timestamp-to-absolute
+ time-stamp
+ (if (or (> current today)
+ (eq org-agenda-prefer-last-repeat t)
+ (member todo-state org-agenda-prefer-last-repeat))
+ today
+ current)
+ 'past (current-buffer) pos))
+ (future
+ ;; Display every repeated date past TODAY (exclusive)
+ ;; unless `org-agenda-show-future-repeats' is nil.
+ ;; If this variable is set to `next', only display
+ ;; the first repeated date after TODAY (exclusive).
+ (cond
+ ((<= current today) past)
+ ((not org-agenda-show-future-repeats) past)
+ (t
+ (let ((base (if (eq org-agenda-show-future-repeats 'next)
+ (1+ today)
+ current)))
+ (org-agenda--timestamp-to-absolute
+ time-stamp base 'future (current-buffer) pos))))))
+ (when (and (/= current past) (/= current future))
+ (throw :skip nil))))
+ (t ;plain time-stamp
+ (pcase-let ((`(,month ,day ,year) date))
+ (unless (string-prefix-p (format "<%d-%02d-%02d" year month day)
+ time-stamp)
+ (throw :skip nil)))))
+ (save-excursion
+ (re-search-backward org-outline-regexp-bol nil t)
+ ;; Possibly skip time-stamp when a deadline is set.
+ (when (and org-agenda-skip-timestamp-if-deadline-is-shown
+ (assq (point) deadlines))
+ (throw :skip nil))
+ (when org-agenda-skip-additional-timestamps-same-entry
+ (push `(timestamp . ,(org-entry-end-position))
+ org-agenda--skip-position))
+ (let* ((category (org-get-category pos))
+ (inherited-tags
+ (or (eq org-agenda-show-inherited-tags 'always)
+ (and (consp 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-at nil (not inherited-tags)))
+ (level (make-string (org-reduced-level (org-outline-level))
+ ?\s))
+ (head (and (looking-at "\\*+[ \t]+\\(.*\\)")
+ (match-string 1)))
+ (habit? (and (fboundp 'org-is-habit-p) (org-is-habit-p)))
+ (item (org-agenda-format-item
+ nil head level category tags time-stamp org-ts-regexp
+ habit?)))
+ (org-add-props item nil
+ 'date date
+ 'face 'org-agenda-calendar-event
+ 'help-echo (format "mouse-2 or RET jump to Org file %S"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer))))
+ 'level level
+ 'mouse-face 'highlight
+ 'org-complex-heading-regexp org-complex-heading-regexp
+ 'org-hd-marker (org-agenda-new-marker)
+ 'org-marker (org-agenda-new-marker pos)
+ 'org-not-done-regexp org-not-done-regexp
+ 'org-todo-regexp org-todo-regexp
+ 'priority (if habit?
+ (org-habit-get-priority (org-habit-parse-todo))
+ (org-get-priority item))
+ 'todo-state todo-state
+ 'ts-date (if time-stamp
+ (org-agenda--timestamp-to-absolute time-stamp)
+ current)
+ 'type "timestamp"
+ 'warntime (get-text-property (point) 'org-appt-warntime)))))))
+
+(defun org-agenda--entry-from-todo (date data)
+ "Return diary entries for DATE associated to a diary S-exp entry.
+
+DATE is a list of the form (MONTH DAY YEAR). DATA is a list of
+the form (POS todo TODO HEADLINE) where POS is the location of
+the headline, TODO its associated keyword and the full headline,
+as strings.
+
+Throw `:skip' if no entry is associated to DATA at DATE. Leave
+point past entries that should be ignored."
+ (pcase-let ((`(,pos ,_ ,todo ,headline) data))
+ ;; Check if we skip current TODO keyword.
+ (cond ((equal org-select-this-todo-keyword "*")) ;accept all
+ (org-select-this-todo-keyword
+ (unless (member todo (split-string org-select-this-todo-keyword
+ "|" t "[ \t]+"))
+ (throw :skip nil)))
+ ((member todo org-done-keywords) (throw :skip nil)))
+ (goto-char pos)
+ (let* ((scheduled (org-entry-get (point) "SCHEDULED"))
+ (deadline (org-entry-get (point) "DEADLINE"))
+ (timestamp (org-entry-get (point) "TIMESTAMP")))
+ (when (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
+ scheduled deadline timestamp)
+ (throw :skip nil))
+ (org-agenda-skip)
+ (unless org-agenda-todo-list-sublevels
+ (push `(todo . ,(save-excursion (org-end-of-subtree t t)))
+ org-agenda--skip-position))
+ (let* ((category (org-get-category))
+ (marker (org-agenda-new-marker))
+ (ts-date-pair (org-agenda-entry-get-agenda-timestamp
+ scheduled deadline timestamp))
+ (ts-date (car ts-date-pair))
+ (ts-date-type (cdr ts-date-pair))
+ (inherited-tags
+ (or (eq org-agenda-show-inherited-tags 'always)
+ (and (listp org-agenda-show-inherited-tags)
+ (memq 'todo org-agenda-show-inherited-tags))
+ (and (eq org-agenda-show-inherited-tags t)
+ (or (eq org-agenda-use-tag-inheritance t)
+ (memq 'todo org-agenda-use-tag-inheritance)))))
+ (tags (org-get-tags-at nil (not inherited-tags)))
+ (level (make-string (org-reduced-level (org-outline-level))
+ ?\s))
+ (priority (1+ (org-get-priority headline)))
+ (item (org-agenda-format-item "" headline level category tags t)))
+ (org-add-props item nil
+ 'done-face 'org-agenda-done
+ 'face nil
+ 'help-echo (format "mouse-2 or RET jump to Org file %S"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer))))
+ 'level level
+ 'mouse-face 'highlight
+ 'org-complex-heading-regexp org-complex-heading-regexp
+ 'org-hd-marker marker
+ 'org-marker marker
+ 'org-not-done-regexp org-not-done-regexp
+ 'org-todo-regexp org-todo-regexp
+ 'priority priority
+ 'todo-state todo
+ 'ts-date ts-date
+ 'type (concat "todo" ts-date-type))))))
+
(defvar org-agenda-buffer-tmp-name nil)
+
;;;###autoload
(defun org-agenda-list (&optional arg start-day span with-hour)
"Produce a daily/weekly view from all files in variable `org-agenda-files'.
@@ -4117,7 +5072,7 @@ items if they have an hour specification like [h]h:mm."
(org-agenda-prepare "Day/Week")
(setq start-day (or start-day org-agenda-start-day))
(if (stringp start-day)
- ;; Convert to an absolute day number
+ ;; Convert to an absolute day number.
(setq start-day (time-to-days (org-read-date nil t start-day))))
(org-compile-prefix-format 'agenda)
(org-set-sorting-strategy 'agenda)
@@ -4128,8 +5083,7 @@ items if they have an hour specification like [h]h:mm."
(org-agenda-start-on-weekday
(if (or (eq ndays 7) (eq ndays 14))
org-agenda-start-on-weekday))
- (thefiles (org-agenda-files nil 'ifmode))
- (files thefiles)
+ (files (org-agenda-files nil 'ifmode))
(start (if (or (null org-agenda-start-on-weekday)
(< ndays 7))
sd
@@ -4138,17 +5092,12 @@ items if they have an hour specification like [h]h:mm."
(n1 org-agenda-start-on-weekday)
(d (- nt n1)))
(- sd (+ (if (< d 0) 7 0) d)))))
- (day-numbers (list start))
+ (day-numbers (number-sequence start (+ start (1- ndays))))
(day-cnt 0)
(inhibit-redisplay (not debug-on-error))
- (org-agenda-show-log-scoped org-agenda-show-log)
- s e rtn rtnall file date d start-pos end-pos todayp
- clocktable-start clocktable-end filter)
+ date start-pos end-pos clocktable-start clocktable-end filter)
(setq org-agenda-redo-command
(list 'org-agenda-list (list 'quote arg) start-day (list 'quote span) with-hour))
- (dotimes (n (1- ndays))
- (push (1+ (car day-numbers)) day-numbers))
- (setq day-numbers (nreverse day-numbers))
(setq clocktable-start (car day-numbers)
clocktable-end (1+ (or (org-last day-numbers) 0)))
(setq-local org-starting-day (car day-numbers))
@@ -4158,8 +5107,8 @@ items if they have an hour specification like [h]h:mm."
(let* ((d1 (car day-numbers))
(d2 (org-last day-numbers))
(w1 (org-days-to-iso-week d1))
- (w2 (org-days-to-iso-week d2)))
- (setq s (point))
+ (w2 (org-days-to-iso-week d2))
+ (s (point)))
(if org-agenda-overriding-header
(insert (org-add-props (copy-sequence org-agenda-overriding-header)
nil 'face 'org-agenda-structure) "\n")
@@ -4170,114 +5119,92 @@ items if they have an hour specification like [h]h:mm."
(format " (W%02d)" w1)
(format " (W%02d-W%02d)" w1 w2))
"")
- ":\n")))
- (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure
- 'org-date-line t))
- (org-agenda-mark-header-line s))
- (while (setq d (pop day-numbers))
- (setq date (calendar-gregorian-from-absolute d)
- s (point))
- (if (or (setq todayp (= d today))
- (and (not start-pos) (= d sd)))
- (setq start-pos (point))
- (if (and start-pos (not end-pos))
- (setq end-pos (point))))
- (setq files thefiles
- rtnall nil)
- (while (setq file (pop files))
- (catch 'nextfile
- (org-check-agenda-file file)
- (let ((org-agenda-entry-types org-agenda-entry-types))
- ;; Starred types override non-starred equivalents
- (when (member :deadline* org-agenda-entry-types)
- (setq org-agenda-entry-types
- (delq :deadline org-agenda-entry-types)))
- (when (member :scheduled* org-agenda-entry-types)
- (setq org-agenda-entry-types
- (delq :scheduled org-agenda-entry-types)))
- ;; Honor with-hour
- (when with-hour
- (when (member :deadline org-agenda-entry-types)
- (setq org-agenda-entry-types
- (delq :deadline org-agenda-entry-types))
- (push :deadline* org-agenda-entry-types))
- (when (member :scheduled org-agenda-entry-types)
- (setq org-agenda-entry-types
- (delq :scheduled org-agenda-entry-types))
- (push :scheduled* org-agenda-entry-types)))
- (unless org-agenda-include-deadlines
- (setq org-agenda-entry-types
- (delq :deadline* (delq :deadline org-agenda-entry-types))))
- (cond
- ((memq org-agenda-show-log-scoped '(only clockcheck))
- (setq rtn (org-agenda-get-day-entries
- file date :closed)))
- (org-agenda-show-log-scoped
- (setq rtn (apply 'org-agenda-get-day-entries
- file date
- (append '(:closed) org-agenda-entry-types))))
- (t
- (setq rtn (apply 'org-agenda-get-day-entries
- file date
- org-agenda-entry-types)))))
- (setq rtnall (append rtnall rtn)))) ;; all entries
- (if org-agenda-include-diary
- (let ((org-agenda-search-headline-for-time t))
- (require 'diary-lib)
- (setq rtn (org-get-entries-from-diary date))
- (setq rtnall (append rtnall rtn))))
- (if (or rtnall org-agenda-show-all-dates)
- (progn
- (setq day-cnt (1+ day-cnt))
- (insert
- (if (stringp org-agenda-format-date)
- (format-time-string org-agenda-format-date
- (org-time-from-absolute date))
- (funcall org-agenda-format-date date))
- "\n")
- (put-text-property s (1- (point)) 'face
- (org-agenda-get-day-face date))
- (put-text-property s (1- (point)) 'org-date-line t)
- (put-text-property s (1- (point)) 'org-agenda-date-header t)
- (put-text-property s (1- (point)) 'org-day-cnt day-cnt)
- (when todayp
- (put-text-property s (1- (point)) 'org-today t))
- (setq rtnall
- (org-agenda-add-time-grid-maybe rtnall ndays todayp))
- (if rtnall (insert ;; all entries
- (org-agenda-finalize-entries rtnall 'agenda)
- "\n"))
+ ":\n"))
+ (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure
+ 'org-date-line t))
+ (org-agenda-mark-header-line s)))
+ (let* ((types (cond
+ ((memq org-agenda-show-log '(only clockcheck))
+ org-agenda-log-mode-items)
+ (org-agenda-show-log
+ (append org-agenda-log-mode-items org-agenda-entry-types))
+ (t org-agenda-entry-types)))
+ ;; Collect all necessary agenda-related data once.
+ (data (delq nil
+ (mapcar (lambda (f)
+ (catch 'nextfile
+ (org-check-agenda-file f)
+ (cons f
+ (org-agenda--file-data f types))))
+ files))))
+ (dolist (d day-numbers)
+ (let ((date (calendar-gregorian-from-absolute d))
+ (today? (= d today))
+ (s (point))
+ (all-entries nil))
+ (cond ((or today? (and (not start-pos) (= d sd)))
+ (setq start-pos (point)))
+ ((and start-pos (not end-pos))
+ (setq end-pos (point)))
+ (t nil))
+ (pcase-dolist (`(,file . ,items) data)
+ (setq all-entries
+ (append (apply #'org-agenda-day-entries
+ date file items types)
+ all-entries)))
+ (when org-agenda-include-diary
+ (let ((org-agenda-search-headline-for-time t))
+ (require 'diary-lib)
+ (setq all-entries
+ (append all-entries (org-get-entries-from-diary date)))))
+ (when (or all-entries org-agenda-show-all-dates)
+ (cl-incf day-cnt)
+ (insert (if (stringp org-agenda-format-date)
+ (format-time-string org-agenda-format-date
+ (org-time-from-absolute date))
+ (funcall org-agenda-format-date date))
+ "\n")
+ (add-text-properties s (1- (point))
+ (list 'face (org-agenda-get-day-face date)
+ 'org-date-line t
+ 'org-agenda-date-header t
+ 'org-day-cnt day-cnt))
+ (when today? (put-text-property s (1- (point)) 'org-today t))
+ (setq all-entries
+ (org-agenda-add-time-grid-maybe all-entries ndays today?))
+ (when all-entries
+ (insert (org-agenda-finalize-entries all-entries 'agenda)
+ "\n"))
(put-text-property s (1- (point)) 'day d)
- (put-text-property s (1- (point)) 'org-day-cnt day-cnt))))
+ (put-text-property s (1- (point)) 'org-day-cnt day-cnt)))))
(when (and org-agenda-clockreport-mode clocktable-start)
- (let ((org-agenda-files (org-agenda-files nil 'ifmode))
- ;; the above line is to ensure the restricted range!
- (p (copy-sequence org-agenda-clockreport-parameter-plist))
- tbl)
- (setq p (org-plist-delete p :block))
- (setq p (plist-put p :tstart clocktable-start))
- (setq p (plist-put p :tend clocktable-end))
- (setq p (plist-put p :scope 'agenda))
- (setq tbl (apply 'org-clock-get-clocktable p))
- (insert tbl)))
+ (let ((org-agenda-files (org-agenda-files nil 'ifmode)))
+ ;; The above line is to ensure the restricted range!
+ (insert
+ (apply #'org-clock-get-clocktable
+ (org-combine-plists org-agenda-clockreport-parameter-plist
+ (list :block nil
+ :tstart clocktable-start
+ :tend clocktable-end
+ :scope 'agenda))))))
(goto-char (point-min))
- (or org-agenda-multi (org-agenda-fit-window-to-buffer))
+ (unless org-agenda-multi (org-agenda-fit-window-to-buffer))
(unless (and (pos-visible-in-window-p (point-min))
(pos-visible-in-window-p (point-max)))
(goto-char (1- (point-max)))
(recenter -1)
- (if (not (pos-visible-in-window-p (or start-pos 1)))
- (progn
- (goto-char (or start-pos 1))
- (recenter 1))))
+ (unless (pos-visible-in-window-p (or start-pos 1))
+ (goto-char (or start-pos 1))
+ (recenter 1)))
(goto-char (or start-pos 1))
- (add-text-properties (point-min) (point-max)
- `(org-agenda-type agenda
- org-last-args (,arg ,start-day ,span)
- org-redo-cmd ,org-agenda-redo-command
- org-series-cmd ,org-cmd))
- (if (eq org-agenda-show-log-scoped 'clockcheck)
- (org-agenda-show-clocking-issues))
+ (add-text-properties
+ (point-min) (point-max)
+ `(org-agenda-type agenda
+ org-last-args (,arg ,start-day ,span)
+ org-redo-cmd ,org-agenda-redo-command
+ org-series-cmd ,org-cmd))
+ (when (eq org-agenda-show-log 'clockcheck)
+ (org-agenda-show-clocking-issues))
(org-agenda-finalize)
(setq buffer-read-only t)
(message ""))))
@@ -4627,9 +5554,6 @@ Press `\\[org-agenda-manipulate-query-add]', \
"|"))
"\n"))
-(defvar org-select-this-todo-keyword nil)
-(defvar org-last-arg nil)
-
;;;###autoload
(defun org-todo-list (&optional arg)
"Show all (not done) TODO entries from all agenda file in a single list.
@@ -4649,7 +5573,7 @@ for a keyword. A numeric prefix directly selects the Nth keyword in
(if (stringp arg) arg
(and arg (integerp arg) (> arg 0)
(nth (1- arg) kwds))))
- rtn rtnall files file pos)
+ pos)
(when (equal arg '(4))
(setq org-select-this-todo-keyword
(completing-read "Keyword (or KWD1|K2D2|...): "
@@ -4670,41 +5594,44 @@ for a keyword. A numeric prefix directly selects the Nth keyword in
current-prefix-arg)
,org-select-this-todo-keyword
current-prefix-arg ,arg)))
- (setq files (org-agenda-files nil 'ifmode)
- rtnall nil)
- (while (setq file (pop files))
- (catch 'nextfile
- (org-check-agenda-file file)
- (setq rtn (org-agenda-get-day-entries file date :todo))
- (setq rtnall (append rtnall rtn))))
- (if org-agenda-overriding-header
- (insert (org-add-props (copy-sequence org-agenda-overriding-header)
- nil 'face 'org-agenda-structure) "\n")
- (insert "Global list of TODO items of type: ")
- (add-text-properties (point-min) (1- (point))
- (list 'face 'org-agenda-structure
- 'short-heading
- (concat "ToDo: "
- (or org-select-this-todo-keyword "ALL"))))
- (org-agenda-mark-header-line (point-min))
- (insert (org-agenda-propertize-selected-todo-keywords
- org-select-this-todo-keyword))
- (setq pos (point))
- (unless org-agenda-multi
- (insert (substitute-command-keys "Available with \
+ (let ((all-entries nil))
+ (dolist (file (org-agenda-files nil 'ifmode))
+ (catch 'nextfile
+ (org-check-agenda-file file)
+ (let ((items (org-agenda--file-data file '(:todo))))
+ (setq all-entries
+ (append all-entries
+ (org-agenda-day-entries date file items :todo))))))
+ (if org-agenda-overriding-header
+ (insert (org-add-props (copy-sequence org-agenda-overriding-header)
+ nil 'face 'org-agenda-structure) "\n")
+ (insert "Global list of TODO items of type: ")
+ (add-text-properties (point-min) (1- (point))
+ (list 'face 'org-agenda-structure
+ 'short-heading
+ (concat "ToDo: "
+ (or org-select-this-todo-keyword
+ "ALL"))))
+ (org-agenda-mark-header-line (point-min))
+ (insert (org-agenda-propertize-selected-todo-keywords
+ org-select-this-todo-keyword))
+ (setq pos (point))
+ (unless org-agenda-multi
+ (insert (substitute-command-keys "Available with \
`N \\[org-agenda-redo]': (0)[ALL]"))
- (let ((n 0) s)
- (mapc (lambda (x)
- (setq s (format "(%d)%s" (setq n (1+ n)) x))
- (if (> (+ (current-column) (string-width s) 1) (frame-width))
- (insert "\n "))
- (insert " " s))
- kwds))
- (insert "\n"))
- (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
- (org-agenda-mark-header-line (point-min))
- (when rtnall
- (insert (org-agenda-finalize-entries rtnall 'todo) "\n"))
+ (let ((n 0))
+ (dolist (k kwds)
+ (let ((s (format "(%d)%s" (cl-incf n) k)))
+ (if (> (+ (current-column) (string-width s) 1)
+ (frame-width))
+ (insert "\n "))
+ (insert " " s))))
+ (insert "\n"))
+ (add-text-properties pos (1- (point))
+ (list 'face 'org-agenda-structure)))
+ (org-agenda-mark-header-line (point-min))
+ (when all-entries
+ (insert (org-agenda-finalize-entries all-entries 'todo) "\n")))
(goto-char (point-min))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(add-text-properties (point-min) (point-max)
@@ -5129,62 +6056,62 @@ Needed to avoid empty dates which mess up holiday display."
;;;###autoload
(defun org-diary (&rest args)
- "Return diary information from org files.
+ "Return diary information from Org files.
This function can be used in a \"sexp\" diary entry in the Emacs calendar.
-It accesses org files and extracts information from those files to be
+It accesses Org files and extracts information from those files to be
listed in the diary. The function accepts arguments specifying what
items should be listed. For a list of arguments allowed here, see the
variable `org-agenda-entry-types'.
The call in the diary file should look like this:
- &%%(org-diary) ~/path/to/some/orgfile.org
+ %%(org-diary) ~/path/to/some/orgfile.org
-Use a separate line for each org file to check. Or, if you omit the file name,
+Use a separate line for each Org file to check. Or, if you omit the file name,
all files listed in `org-agenda-files' will be checked automatically:
- &%%(org-diary)
+ %%(org-diary)
If you don't give any arguments (as in the example above), the default value
of `org-agenda-entry-types' is used: (:deadline :scheduled :timestamp :sexp).
So the example above may also be written as
- &%%(org-diary :deadline :timestamp :sexp :scheduled)
+ %%(org-diary :deadline :timestamp :sexp :scheduled)
The function expects the lisp variables `entry' and `date' to be provided
by the caller, because this is how the calendar works. Don't use this
-function from a program - use `org-agenda-get-day-entries' instead."
- (when (> (- (float-time)
- org-agenda-last-marker-time)
- 5)
- ;; I am not sure if this works with sticky agendas, because the marker
- ;; list is then no longer a global variable.
+function from a program - use `org-agenda-day-entries' instead."
+ (when (<= 5 (- org-agenda-last-marker-time (float-time)))
+ ;; I am not sure if this works with sticky agendas, because the
+ ;; marker list is then no longer a global variable.
(org-agenda-reset-markers))
(org-compile-prefix-format 'agenda)
(org-set-sorting-strategy 'agenda)
(setq args (or args org-agenda-entry-types))
- (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry))
- (list entry)
- (org-agenda-files t)))
- (time (float-time))
- file rtn results)
+ (let ((time (float-time))
+ (files (if (org-string-nw-p entry) (list entry)
+ (org-agenda-files t))))
(when (or (not org-diary-last-run-time)
- (> (- time
- org-diary-last-run-time)
- 3))
+ (<= 3 (- time org-diary-last-run-time)))
(org-agenda-prepare-buffers files))
(setq org-diary-last-run-time time)
- ;; If this is called during org-agenda, don't return any entries to
- ;; the calendar. Org Agenda will list these entries itself.
- (if org-disable-agenda-to-diary (setq files nil))
- (while (setq file (pop files))
- (setq rtn (apply 'org-agenda-get-day-entries file date args))
- (setq results (append results rtn)))
- (when results
- (setq results
- (mapcar (lambda (i) (replace-regexp-in-string
- org-bracket-link-regexp "\\3" i)) results))
- (concat (org-agenda-finalize-entries results) "\n"))))
+ ;; If this is called during `org-agenda', don't return any entries
+ ;; to the calendar. Org Agenda will list these entries itself.
+ (unless org-disable-agenda-to-diary
+ (let ((entries nil))
+ (dolist (file files)
+ (let ((items (org-agenda--file-data file args)))
+ (setq entries
+ (append entries
+ (apply #'org-agenda-day-entries
+ date file items args)))))
+ (when entries
+ (concat (org-agenda-finalize-entries
+ (mapcar (lambda (i)
+ (replace-regexp-in-string
+ org-bracket-link-regexp "\\3" i))
+ entries))
+ "\n"))))))
;;; Agenda entry finders
@@ -5198,67 +6125,85 @@ However, throw `:skip' whenever an error is raised."
(message "%s; Skipping entry" (error-message-string e))
(throw :skip nil))))
-(defun org-agenda-get-day-entries (file date &rest args)
- "Does the work for `org-diary' and `org-agenda'.
-FILE is the path to a file to be checked for entries. DATE is date like
-the one returned by `calendar-current-date'. ARGS are symbols indicating
-which kind of entries should be extracted. For details about these, see
-the documentation of `org-diary'."
- (let* ((org-startup-folded nil)
- (org-startup-align-all-tables nil)
- (buffer (if (file-exists-p file) (org-get-agenda-file-buffer file)
- (error "No such file %s" file))))
- (if (not buffer)
- ;; If file does not exist, signal it in diary nonetheless.
- (list (format "ORG-AGENDA-ERROR: No such org-file %s" file))
- (with-current-buffer buffer
- (unless (derived-mode-p 'org-mode)
- (error "Agenda file %s is not in `org-mode'" file))
- (setq org-agenda-buffer (or org-agenda-buffer buffer))
- (setf org-agenda-current-date date)
- (save-excursion
- (save-restriction
- (if (eq buffer org-agenda-restrict)
- (narrow-to-region org-agenda-restrict-begin
- org-agenda-restrict-end)
- (widen))
- ;; Rationalize ARGS. Also make sure `:deadline' comes
- ;; first in order to populate DEADLINES before passing it.
- ;;
- ;; We use `delq' since `org-uniquify' duplicates ARGS,
- ;; guarding us from modifying `org-agenda-entry-types'.
- (setf args (org-uniquify (or args org-agenda-entry-types)))
- (when (and (memq :scheduled args) (memq :scheduled* args))
- (setf args (delq :scheduled* args)))
- (cond
- ((memq :deadline args)
- (setf args (cons :deadline
- (delq :deadline (delq :deadline* args)))))
- ((memq :deadline* args)
- (setf args (cons :deadline* (delq :deadline* args)))))
- ;; Collect list of headlines. Return them flattened.
- (let ((case-fold-search nil) results deadlines)
- (dolist (arg args (apply #'nconc (nreverse results)))
- (pcase arg
- ((and :todo (guard (org-agenda-today-p date)))
- (push (org-agenda-get-todos) results))
- (:timestamp
- (push (org-agenda-get-blocks) results)
- (push (org-agenda-get-timestamps deadlines) results))
- (:sexp
- (push (org-agenda-get-sexps) results))
- (:scheduled
- (push (org-agenda-get-scheduled deadlines) results))
- (:scheduled*
- (push (org-agenda-get-scheduled deadlines t) results))
- (:closed
- (push (org-agenda-get-progress) results))
- (:deadline
- (setf deadlines (org-agenda-get-deadlines))
- (push deadlines results))
- (:deadline*
- (setf deadlines (org-agenda-get-deadlines t))
- (push deadlines results)))))))))))
+(defun org-agenda-day-entries (date file data &rest types)
+ "Return a list of agenda entries for DATE in FILE.
+DATE is date like the one returned by `calendar-current-date'.
+FILE is the filename containing the data. DATA is the data to
+process, as returned by `org-agenda--file-data'. TYPES are
+keywords indicating which kind of entries should be extracted."
+ (setf org-agenda-current-date date)
+ (let* ((with-hours? (or (memq :deadline* types)
+ (memq :scheduled* types)))
+ (deadline? (and org-agenda-include-deadlines
+ (or (memq :deadline types)
+ (memq :deadline* types))))
+ (scheduled? (or (memq :scheduled types)
+ (memq :scheduled* types)))
+ (today? (org-agenda-today-p date)))
+ (with-current-buffer (org-get-agenda-file-buffer file)
+ ;; Get deadline entries first since the information is needed in
+ ;; other entries converters.
+ (org-with-point-at 1
+ (let* ((deadline-entries
+ (and deadline?
+ (delq nil
+ (mapcar (lambda (datum)
+ (catch :skip
+ (and (eq 'deadline (nth 1 datum))
+ (org-agenda--entry-from-deadline
+ date datum with-hours?))))
+ data))))
+ (deadline-positions
+ (mapcar (lambda (d)
+ (let ((m (get-text-property 0 'org-hd-marker d)))
+ (and m (marker-position m))))
+ deadline-entries))
+ (org-agenda--skip-position nil)
+ (results nil))
+ (dolist (datum data)
+ (catch :skip
+ (pcase-let* ((`(,pos ,type . ,_) datum)
+ (skip-pos
+ (let ((p (cdr (assq type
+ org-agenda--skip-position))))
+ (if p (max p (point)) (point)))))
+ (pcase type
+ ((guard (< pos skip-pos))
+ ;; Calling `:skip' possibly moved point past the
+ ;; region to ignore. Since data is ordered, it
+ ;; means we have to ignore every element before
+ ;; point. We also need to obey specific skip
+ ;; conditions in `org-agenda--skip-position'.
+ nil)
+ (`diary
+ ;; Unlike other converters,
+ ;; `org-agenda--entry-from-diary' returns a list
+ ;; of entries instead of a single entry.
+ (setq results
+ (nconc (org-agenda--entry-from-diary date datum)
+ results)))
+ ((or `clock `closed `state)
+ (push (org-agenda--entry-from-log date datum)
+ results))
+ (`deadline nil) ;already done
+ (`range
+ (push (org-agenda--entry-from-range date datum)
+ results))
+ (`scheduled
+ (when scheduled?
+ (push (org-agenda--entry-from-scheduled
+ date datum deadline-positions with-hours?)
+ results)))
+ (`timestamp
+ (push (org-agenda--entry-from-timestamp
+ date datum deadline-positions)
+ results))
+ (`todo
+ (when today?
+ (push (org-agenda--entry-from-todo date datum)
+ results)))
+ (_ (error "Unknown agenda entry type: %S" type))))))
+ (nconc deadline-entries results))))))
(defsubst org-em (x y list)
"Is X or Y a member of LIST?"
@@ -5267,112 +6212,47 @@ the documentation of `org-diary'."
(defvar org-heading-keyword-regexp-format) ; defined in org.el
(defvar org-agenda-sorting-strategy-selected nil)
-(defun org-agenda-entry-get-agenda-timestamp (pom)
+(defun org-agenda-entry-get-agenda-timestamp
+ (&optional scheduled deadline timestamp)
"Retrieve timestamp information for sorting agenda views.
-Given a point or marker POM, returns a cons cell of the timestamp
-and the timestamp type relevant for the sorting strategy in
-`org-agenda-sorting-strategy-selected'."
- (let (ts ts-date-type)
+
+Optional arguments SCHEDULED, DEADLINE and TIMESTAMP are,
+respectively, the scheduled, deadline, and first timestamp in the
+entry, or nil.
+
+Return a cons cell (VALUE . TYPE) of the timestamp and the
+timestamp type relevant for the sorting strategy in
+`org-agenda-sorting-strategy-selected'.
+
+The function doesn't change match data."
+ (let ((value nil)
+ (type nil))
(save-match-data
(cond ((org-em 'scheduled-up 'scheduled-down
org-agenda-sorting-strategy-selected)
- (setq ts (org-entry-get pom "SCHEDULED")
- ts-date-type " scheduled"))
+ (setq value (or scheduled (org-entry-get (point) "SCHEDULED")))
+ (setq type " scheduled"))
((org-em 'deadline-up 'deadline-down
org-agenda-sorting-strategy-selected)
- (setq ts (org-entry-get pom "DEADLINE")
- ts-date-type " deadline"))
+ (setq value (or deadline (org-entry-get (point) "DEADLINE")))
+ (setq type " deadline"))
((org-em 'ts-up 'ts-down
org-agenda-sorting-strategy-selected)
- (setq ts (org-entry-get pom "TIMESTAMP")
- ts-date-type " timestamp"))
+ (setq value (or timestamp (org-entry-get (point) "TIMESTAMP")))
+ (setq type " timestamp"))
((org-em 'tsia-up 'tsia-down
org-agenda-sorting-strategy-selected)
- (setq ts (org-entry-get pom "TIMESTAMP_IA")
- ts-date-type " timestamp_ia"))
+ (setq value (org-entry-get (point) "TIMESTAMP_IA"))
+ (setq type " timestamp_ia"))
((org-em 'timestamp-up 'timestamp-down
org-agenda-sorting-strategy-selected)
- (setq ts (or (org-entry-get pom "SCHEDULED")
- (org-entry-get pom "DEADLINE")
- (org-entry-get pom "TIMESTAMP")
- (org-entry-get pom "TIMESTAMP_IA"))
- ts-date-type ""))
- (t (setq ts-date-type "")))
- (cons (when ts (ignore-errors (org-time-string-to-absolute ts)))
- ts-date-type))))
-
-(defun org-agenda-get-todos ()
- "Return the TODO information for agenda display."
- (let* ((props (list 'face nil
- 'done-face 'org-agenda-done
- 'org-not-done-regexp org-not-done-regexp
- 'org-todo-regexp org-todo-regexp
- 'org-complex-heading-regexp org-complex-heading-regexp
- 'mouse-face 'highlight
- 'help-echo
- (format "mouse-2 or RET jump to org file %s"
- (abbreviate-file-name buffer-file-name))))
- (case-fold-search nil)
- (regexp (format org-heading-keyword-regexp-format
- (cond
- ((and org-select-this-todo-keyword
- (equal org-select-this-todo-keyword "*"))
- org-todo-regexp)
- (org-select-this-todo-keyword
- (concat "\\("
- (mapconcat 'identity
- (org-split-string
- org-select-this-todo-keyword
- "|")
- "\\|") "\\)"))
- (t org-not-done-regexp))))
- marker priority category level tags todo-state
- ts-date ts-date-type ts-date-pair
- ee txt beg end inherited-tags todo-state-end-pos)
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (catch :skip
- (save-match-data
- (beginning-of-line)
- (org-agenda-skip)
- (setq beg (point) end (save-excursion (outline-next-heading) (point)))
- (unless (and (setq todo-state (org-get-todo-state))
- (setq todo-state-end-pos (match-end 2)))
- (goto-char end)
- (throw :skip nil))
- (when (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item end)
- (goto-char (1+ beg))
- (or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible))
- (throw :skip nil)))
- (goto-char (match-beginning 2))
- (setq marker (org-agenda-new-marker (match-beginning 0))
- category (org-get-category)
- ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
- ts-date (car ts-date-pair)
- ts-date-type (cdr ts-date-pair)
- txt (org-trim (buffer-substring (match-beginning 2) (match-end 0)))
- inherited-tags
- (or (eq org-agenda-show-inherited-tags 'always)
- (and (listp org-agenda-show-inherited-tags)
- (memq 'todo org-agenda-show-inherited-tags))
- (and (eq org-agenda-show-inherited-tags t)
- (or (eq org-agenda-use-tag-inheritance t)
- (memq 'todo org-agenda-use-tag-inheritance))))
- tags (org-get-tags-at nil (not inherited-tags))
- level (make-string (org-reduced-level (org-outline-level)) ? )
- txt (org-agenda-format-item "" txt level category tags t)
- priority (1+ (org-get-priority txt)))
- (org-add-props txt props
- 'org-marker marker 'org-hd-marker marker
- 'priority priority
- 'level level
- 'ts-date ts-date
- 'type (concat "todo" ts-date-type) 'todo-state todo-state)
- (push txt ee)
- (if org-agenda-todo-list-sublevels
- (goto-char todo-state-end-pos)
- (org-end-of-subtree 'invisible))))
- (nreverse ee)))
+ (setq value (or scheduled (org-entry-get (point) "SCHEDULED")
+ deadline (org-entry-get (point) "DEADLINE")
+ timestamp (org-entry-get (point) "TIMESTAMP")
+ (org-entry-get (point) "TIMESTAMP_IA")))
+ (setq value "")))
+ (cons (and value (ignore-errors (org-time-string-to-absolute value)))
+ type))))
(defun org-agenda-todo-custom-ignore-p (time n)
"Check whether timestamp is farther away than n number of days.
@@ -5387,272 +6267,80 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
;;;###autoload
(defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
- (&optional end)
- "Do we have a reason to ignore this TODO entry because it has a time stamp?"
- (when (or org-agenda-todo-ignore-with-date
- org-agenda-todo-ignore-scheduled
- org-agenda-todo-ignore-deadlines
- org-agenda-todo-ignore-timestamp)
- (setq end (or end (save-excursion (outline-next-heading) (point))))
- (save-excursion
- (or (and org-agenda-todo-ignore-with-date
- (re-search-forward org-ts-regexp end t))
- (and org-agenda-todo-ignore-scheduled
- (re-search-forward org-scheduled-time-regexp end t)
- (cond
- ((eq org-agenda-todo-ignore-scheduled 'future)
- (> (org-time-stamp-to-now
- (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
- ((eq org-agenda-todo-ignore-scheduled 'past)
- (<= (org-time-stamp-to-now
- (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
- ((numberp org-agenda-todo-ignore-scheduled)
- (org-agenda-todo-custom-ignore-p
- (match-string 1) org-agenda-todo-ignore-scheduled))
- (t)))
- (and org-agenda-todo-ignore-deadlines
- (re-search-forward org-deadline-time-regexp end t)
- (cond
- ((memq org-agenda-todo-ignore-deadlines '(t all)) t)
- ((eq org-agenda-todo-ignore-deadlines 'far)
- (not (org-deadline-close-p (match-string 1))))
- ((eq org-agenda-todo-ignore-deadlines 'future)
- (> (org-time-stamp-to-now
- (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
- ((eq org-agenda-todo-ignore-deadlines 'past)
- (<= (org-time-stamp-to-now
- (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
- ((numberp org-agenda-todo-ignore-deadlines)
- (org-agenda-todo-custom-ignore-p
- (match-string 1) org-agenda-todo-ignore-deadlines))
- (t (org-deadline-close-p (match-string 1)))))
- (and org-agenda-todo-ignore-timestamp
- (let ((buffer (current-buffer))
- (regexp
- (concat
- org-scheduled-time-regexp "\\|" org-deadline-time-regexp))
- (start (point)))
- ;; Copy current buffer into a temporary one
- (with-temp-buffer
- (insert-buffer-substring buffer start end)
- (goto-char (point-min))
- ;; Delete SCHEDULED and DEADLINE items
- (while (re-search-forward regexp end t)
- (delete-region (match-beginning 0) (match-end 0)))
- (goto-char (point-min))
- ;; No search for timestamp left
- (when (re-search-forward org-ts-regexp nil t)
- (cond
- ((eq org-agenda-todo-ignore-timestamp 'future)
- (> (org-time-stamp-to-now
- (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
- ((eq org-agenda-todo-ignore-timestamp 'past)
- (<= (org-time-stamp-to-now
- (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
- ((numberp org-agenda-todo-ignore-timestamp)
- (org-agenda-todo-custom-ignore-p
- (match-string 1) org-agenda-todo-ignore-timestamp))
- (t))))))))))
-
-(defun org-agenda-get-timestamps (&optional deadlines)
- "Return the date stamp information for agenda display.
-Optional argument DEADLINES is a list of deadline items to be
-displayed in agenda view."
- (let* ((props (list 'face 'org-agenda-calendar-event
- 'org-not-done-regexp org-not-done-regexp
- 'org-todo-regexp org-todo-regexp
- 'org-complex-heading-regexp org-complex-heading-regexp
- 'mouse-face 'highlight
- 'help-echo
- (format "mouse-2 or RET jump to Org file %s"
- (abbreviate-file-name buffer-file-name))))
- (current (calendar-absolute-from-gregorian date))
- (today (org-today))
- (deadline-position-alist
- (mapcar (lambda (d)
- (let ((m (get-text-property 0 'org-hd-marker d)))
- (and m (marker-position m))))
- deadlines))
- ;; Match time-stamps set to current date, time-stamps with
- ;; a repeater, and S-exp time-stamps.
- (regexp
- (concat
- (if org-agenda-include-inactive-timestamps "[[<]" "<")
- (regexp-quote
- (substring
- (format-time-string
- (car org-time-stamp-formats)
- (apply #'encode-time ; DATE bound by calendar
- (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
- 1 11))
- "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)"
- "\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
- timestamp-items)
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- ;; Skip date ranges, scheduled and deadlines, which are handled
- ;; specially. Also skip time-stamps before first headline as
- ;; there would be no entry to add to the agenda. Eventually,
- ;; ignore clock entries.
- (catch :skip
- (save-match-data
- (when (or (org-at-date-range-p)
- (org-at-planning-p)
- (org-before-first-heading-p)
- (and org-agenda-include-inactive-timestamps
- (org-at-clock-log-p)))
- (throw :skip nil))
- (org-agenda-skip))
- (let* ((pos (match-beginning 0))
- (repeat (match-string 1))
- (sexp-entry (match-string 3))
- (time-stamp (if (or repeat sexp-entry) (match-string 0)
- (save-excursion
- (goto-char pos)
- (looking-at org-ts-regexp-both)
- (match-string 0))))
- (todo-state (org-get-todo-state))
- (warntime (get-text-property (point) 'org-appt-warntime))
- (done? (member todo-state org-done-keywords)))
- ;; Possibly skip done tasks.
- (when (and done? org-agenda-skip-timestamp-if-done)
- (throw :skip t))
- ;; S-exp entry doesn't match current day: skip it.
- (when (and sexp-entry (not (org-diary-sexp-entry sexp-entry "" date)))
- (throw :skip nil))
- (when repeat
- (let* ((past
- ;; A repeating time stamp is shown at its base
- ;; date and every repeated date up to TODAY. If
- ;; `org-agenda-prefer-last-repeat' is non-nil,
- ;; however, only the last repeat before today
- ;; (inclusive) is shown.
- (org-agenda--timestamp-to-absolute
- repeat
- (if (or (> current today)
- (eq org-agenda-prefer-last-repeat t)
- (member todo-state org-agenda-prefer-last-repeat))
- today
- current)
- 'past (current-buffer) pos))
- (future
- ;; Display every repeated date past TODAY
- ;; (exclusive) unless
- ;; `org-agenda-show-future-repeats' is nil. If
- ;; this variable is set to `next', only display
- ;; the first repeated date after TODAY
- ;; (exclusive).
- (cond
- ((<= current today) past)
- ((not org-agenda-show-future-repeats) past)
- (t
- (let ((base (if (eq org-agenda-show-future-repeats 'next)
- (1+ today)
- current)))
- (org-agenda--timestamp-to-absolute
- repeat base 'future (current-buffer) pos))))))
- (when (and (/= current past) (/= current future))
- (throw :skip nil))))
- (save-excursion
- (re-search-backward org-outline-regexp-bol nil t)
- ;; Possibly skip time-stamp when a deadline is set.
- (when (and org-agenda-skip-timestamp-if-deadline-is-shown
- (assq (point) deadline-position-alist))
- (throw :skip nil))
- (let* ((category (org-get-category pos))
- (inherited-tags
- (or (eq org-agenda-show-inherited-tags 'always)
- (and (consp 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-at nil (not inherited-tags)))
- (level (make-string (org-reduced-level (org-outline-level))
- ?\s))
- (head (and (looking-at "\\*+[ \t]+\\(.*\\)")
- (match-string 1)))
- (inactive? (= (char-after pos) ?\[))
- (habit? (and (fboundp 'org-is-habit-p) (org-is-habit-p)))
- (item
- (org-agenda-format-item
- (and inactive? org-agenda-inactive-leader)
- head level category tags time-stamp org-ts-regexp habit?)))
- (org-add-props item props
- 'priority (if habit?
- (org-habit-get-priority (org-habit-parse-todo))
- (org-get-priority item))
- 'org-marker (org-agenda-new-marker pos)
- 'org-hd-marker (org-agenda-new-marker)
- 'date date
- 'level level
- 'ts-date (if repeat (org-agenda--timestamp-to-absolute repeat)
- current)
- 'todo-state todo-state
- 'warntime warntime
- 'type "timestamp")
- (push item timestamp-items))))
- (when org-agenda-skip-additional-timestamps-same-entry
- (outline-next-heading))))
- (nreverse timestamp-items)))
-
-(defun org-agenda-get-sexps ()
- "Return the sexp information for agenda display."
- (require 'diary-lib)
- (let* ((props (list 'face 'org-agenda-calendar-sexp
- 'mouse-face 'highlight
- 'help-echo
- (format "mouse-2 or RET jump to org file %s"
- (abbreviate-file-name buffer-file-name))))
- (regexp "^&?%%(")
- marker category extra level ee txt tags entry
- result beg b sexp sexp-entry todo-state warntime inherited-tags)
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (catch :skip
- (org-agenda-skip)
- (setq beg (match-beginning 0))
- (goto-char (1- (match-end 0)))
- (setq b (point))
- (forward-sexp 1)
- (setq sexp (buffer-substring b (point)))
- (setq sexp-entry (if (looking-at "[ \t]*\\(\\S-.*\\)")
- (org-trim (match-string 1))
- ""))
- (setq result (org-diary-sexp-entry sexp sexp-entry date))
- (when result
- (setq marker (org-agenda-new-marker beg)
- level (make-string (org-reduced-level (org-outline-level)) ? )
- category (org-get-category beg)
- 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-at nil (not inherited-tags))
- todo-state (org-get-todo-state)
- warntime (get-text-property (point) 'org-appt-warntime)
- extra nil)
-
- (dolist (r (if (stringp result)
- (list result)
- result)) ;; we expect a list here
- (when (and org-agenda-diary-sexp-prefix
- (string-match org-agenda-diary-sexp-prefix r))
- (setq extra (match-string 0 r)
- r (replace-match "" nil nil r)))
- (if (string-match "\\S-" r)
- (setq txt r)
- (setq txt "SEXP entry returned empty string"))
- (setq txt (org-agenda-format-item extra txt level category tags 'time))
- (org-add-props txt props 'org-marker marker
- 'date date 'todo-state todo-state
- 'level level 'type "sexp" 'warntime warntime)
- (push txt ee)))))
- (nreverse ee)))
+ (&optional scheduled deadline timestamp)
+ "Non-nil if this TODO entry is to be ignored because of a time stamp.
+Optional arguments SCHEDULED, DEADLINE and TIMESTAMP are,
+respectively, the scheduled, deadline, and first timestamp in the
+entry, or nil."
+ (let ((scheduled (or scheduled (org-entry-get (point) "SCHEDULED")))
+ (deadline (or deadline (org-entry-get (point) "DEADLINE")))
+ (timestamp (or timestamp (org-entry-get (point) "TIMESTAMP"))))
+ (catch :ignore
+ (when (and org-agenda-todo-ignore-with-date
+ (or scheduled deadline timestamp))
+ (throw :ignore t))
+ (when (and scheduled org-agenda-todo-ignore-scheduled)
+ (pcase org-agenda-todo-ignore-scheduled
+ (`future
+ (when (> (org-time-stamp-to-now
+ scheduled
+ org-agenda-todo-ignore-time-comparison-use-seconds)
+ 0)
+ (throw :ignore t)))
+ (`past
+ (when (<= (org-time-stamp-to-now
+ scheduled
+ org-agenda-todo-ignore-time-comparison-use-seconds)
+ 0)
+ (throw :ignore t)))
+ ((pred numberp)
+ (org-agenda-todo-custom-ignore-p scheduled
+ org-agenda-todo-ignore-scheduled))
+ (_ (throw :ignore t))))
+ (when (and deadline org-agenda-todo-ignore-deadlines)
+ (pcase org-agenda-todo-ignore-deadlines
+ ((or `t `all) (throw :ignore t))
+ (`far
+ (when (not (org-deadline-close-p deadline))
+ (throw :ignore t)))
+ (`future
+ (when (> (org-time-stamp-to-now
+ deadline
+ org-agenda-todo-ignore-time-comparison-use-seconds)
+ 0)
+ (throw :ignore t)))
+ (`past
+ (when (<= (org-time-stamp-to-now
+ deadline
+ org-agenda-todo-ignore-time-comparison-use-seconds)
+ 0)
+ (throw :ignore t)))
+ ((pred numberp)
+ (when (org-agenda-todo-custom-ignore-p
+ deadline org-agenda-todo-ignore-deadlines)
+ (throw :ignore t)))
+ (_
+ (when (org-deadline-close-p deadline) (throw :ignore t)))))
+ (when (and timestamp org-agenda-todo-ignore-timestamp)
+ (pcase org-agenda-todo-ignore-timestamp
+ (`future
+ (when (> (org-time-stamp-to-now
+ timestamp
+ org-agenda-todo-ignore-time-comparison-use-seconds)
+ 0)
+ (throw :ignore t)))
+ (`past
+ (when (<= (org-time-stamp-to-now
+ timestamp
+ org-agenda-todo-ignore-time-comparison-use-seconds)
+ 0)
+ (throw :ignore t)))
+ ((pred numberp)
+ (org-agenda-todo-custom-ignore-p timestamp
+ org-agenda-todo-ignore-timestamp))
+ (_ (throw :ignore t))))
+ ;; No reason. Move on.
+ nil)))
;; Calendar sanity: define some functions that are independent of
;; `calendar-date-style'.
@@ -5702,110 +6390,6 @@ then those holidays will be skipped."
(delq nil (mapcar (lambda(g) (member g skip-weeks)) h))))
entry)))
-(defalias 'org-get-closed 'org-agenda-get-progress)
-(defun org-agenda-get-progress ()
- "Return the logged TODO entries for agenda display."
- (let* ((props (list 'mouse-face 'highlight
- 'org-not-done-regexp org-not-done-regexp
- 'org-todo-regexp org-todo-regexp
- 'org-complex-heading-regexp org-complex-heading-regexp
- 'help-echo
- (format "mouse-2 or RET jump to org file %s"
- (abbreviate-file-name buffer-file-name))))
- (items (if (consp org-agenda-show-log-scoped)
- org-agenda-show-log-scoped
- (if (eq org-agenda-show-log-scoped 'clockcheck)
- '(clock)
- org-agenda-log-mode-items)))
- (parts
- (delq nil
- (list
- (if (memq 'closed items) (concat "\\<" org-closed-string))
- (if (memq 'clock items) (concat "\\<" org-clock-string))
- (if (memq 'state items) "- State \"\\([a-zA-Z0-9]+\\)\".*?"))))
- (parts-re (if parts (mapconcat 'identity parts "\\|")
- (error "`org-agenda-log-mode-items' is empty")))
- (regexp (concat
- "\\(" parts-re "\\)"
- " *\\["
- (regexp-quote
- (substring
- (format-time-string
- (car org-time-stamp-formats)
- (apply 'encode-time ; DATE bound by calendar
- (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
- 1 11))))
- (org-agenda-search-headline-for-time nil)
- marker hdmarker priority category level tags closedp
- statep clockp state ee txt extra timestr rest clocked inherited-tags)
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (catch :skip
- (org-agenda-skip)
- (setq marker (org-agenda-new-marker (match-beginning 0))
- closedp (equal (match-string 1) org-closed-string)
- statep (equal (string-to-char (match-string 1)) ?-)
- clockp (not (or closedp statep))
- state (and statep (match-string 2))
- category (org-get-category (match-beginning 0))
- timestr (buffer-substring (match-beginning 0) (point-at-eol)))
- (when (string-match "\\]" timestr)
- ;; substring should only run to end of time stamp
- (setq rest (substring timestr (match-end 0))
- timestr (substring timestr 0 (match-end 0)))
- (if (and (not closedp) (not statep)
- (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)"
- rest))
- (progn (setq timestr (concat (substring timestr 0 -1)
- "-" (match-string 1 rest) "]"))
- (setq clocked (match-string 2 rest)))
- (setq clocked "-")))
- (save-excursion
- (setq extra
- (cond
- ((not org-agenda-log-mode-add-notes) nil)
- (statep
- (and (looking-at ".*\\\\\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$")
- (match-string 1)))
- (clockp
- (and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$")
- (match-string 1)))))
- (if (not (re-search-backward org-outline-regexp-bol nil t))
- (throw :skip nil)
- (goto-char (match-beginning 0))
- (setq hdmarker (org-agenda-new-marker)
- inherited-tags
- (or (eq org-agenda-show-inherited-tags 'always)
- (and (listp org-agenda-show-inherited-tags)
- (memq 'todo org-agenda-show-inherited-tags))
- (and (eq org-agenda-show-inherited-tags t)
- (or (eq org-agenda-use-tag-inheritance t)
- (memq 'todo org-agenda-use-tag-inheritance))))
- tags (org-get-tags-at nil (not inherited-tags))
- level (make-string (org-reduced-level (org-outline-level)) ? ))
- (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
- (setq txt (match-string 1))
- (when extra
- (if (string-match "\\([ \t]+\\)\\(:[^ \n\t]*?:\\)[ \t]*$" txt)
- (setq txt (concat (substring txt 0 (match-beginning 1))
- " - " extra " " (match-string 2 txt)))
- (setq txt (concat txt " - " extra))))
- (setq txt (org-agenda-format-item
- (cond
- (closedp "Closed: ")
- (statep (concat "State: (" state ")"))
- (t (concat "Clocked: (" clocked ")")))
- txt level category tags timestr)))
- (setq priority 100000)
- (org-add-props txt props
- 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done
- 'priority priority 'level level
- 'type "closed" 'date date
- 'undone-face 'org-warning 'done-face 'org-agenda-done)
- (push txt ee))
- (goto-char (point-at-eol))))
- (nreverse ee)))
-
(defun org-agenda-show-clocking-issues ()
"Add overlays, showing issues with clocking.
See also the user option `org-agenda-clock-consistency-checks'."
@@ -5923,457 +6507,13 @@ See also the user option `org-agenda-clock-consistency-checks'."
;; Nope, this gap is not OK
nil)))
-(defun org-agenda-get-deadlines (&optional with-hour)
- "Return the deadline information for agenda display.
-When WITH-HOUR is non-nil, only return deadlines with an hour
-specification like [h]h:mm."
- (let* ((props (list 'mouse-face 'highlight
- 'org-not-done-regexp org-not-done-regexp
- 'org-todo-regexp org-todo-regexp
- 'org-complex-heading-regexp org-complex-heading-regexp
- 'help-echo
- (format "mouse-2 or RET jump to org file %s"
- (abbreviate-file-name buffer-file-name))))
- (regexp (if with-hour
- org-deadline-time-hour-regexp
- org-deadline-time-regexp))
- (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))
- (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 (if suppress-prewarning
- (let ((org-deadline-warning-days suppress-prewarning))
- (org-get-wdays s))
- (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))
- (level (make-string (org-reduced-level (org-outline-level))
- ?\s))
- (head (buffer-substring (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-at 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)))
- head 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
- 'ts-date deadline
- 'priority
- ;; Adjust priority to today reminders about deadlines.
- ;; Overdue deadlines get the highest priority
- ;; increase, then imminent deadlines and eventually
- ;; more distant deadlines.
- (let ((adjust (if today? (- diff) 0)))
- (+ adjust (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))))))
- (nreverse deadline-items)))
-
(defun org-agenda-deadline-face (fraction)
"Return the face to displaying a deadline item.
FRACTION is what fraction of the head-warning time has passed."
(assoc-default fraction org-agenda-deadline-faces #'<=))
-(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."
- (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))
- (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))
- (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)
- (> current schedule))
- 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 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))
- (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-at 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.
- ((and (/= 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))
- head level category tags time nil habitp))
- (face (cond ((and (not habitp) pastschedp)
- 'org-scheduled-previously)
- (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
- '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)))
-
-(defun org-agenda-get-blocks ()
- "Return the date-range information for agenda display."
- (let* ((props (list 'face nil
- 'org-not-done-regexp org-not-done-regexp
- 'org-todo-regexp org-todo-regexp
- 'org-complex-heading-regexp org-complex-heading-regexp
- 'mouse-face 'highlight
- 'help-echo
- (format "mouse-2 or RET jump to org file %s"
- (abbreviate-file-name buffer-file-name))))
- (regexp org-tr-regexp)
- (d0 (calendar-absolute-from-gregorian date))
- marker hdmarker ee txt d1 d2 s1 s2 category
- level todo-state tags pos head donep inherited-tags)
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (catch :skip
- (org-agenda-skip)
- (setq pos (point))
- (let ((start-time (match-string 1))
- (end-time (match-string 2)))
- (setq s1 (match-string 1)
- s2 (match-string 2)
- d1 (time-to-days
- (condition-case err
- (org-time-string-to-time s1)
- (error
- (error
- "Bad timestamp %S at %d in buffer %S\nError was: %s"
- s1
- pos
- (current-buffer)
- (error-message-string err)))))
- d2 (time-to-days
- (condition-case err
- (org-time-string-to-time s2)
- (error
- (error
- "Bad timestamp %S at %d in buffer %S\nError was: %s"
- s2
- pos
- (current-buffer)
- (error-message-string err))))))
- (if (and (> (- d0 d1) -1) (> (- d2 d0) -1))
- ;; Only allow days between the limits, because the normal
- ;; date stamps will catch the limits.
- (save-excursion
- (setq todo-state (org-get-todo-state))
- (setq donep (member todo-state org-done-keywords))
- (if (and donep org-agenda-skip-timestamp-if-done)
- (throw :skip t))
- (setq marker (org-agenda-new-marker (point))
- category (org-get-category))
- (if (not (re-search-backward org-outline-regexp-bol nil t))
- (throw :skip nil)
- (goto-char (match-beginning 0))
- (setq hdmarker (org-agenda-new-marker (point))
- 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-at nil (not inherited-tags)))
- (setq level (make-string (org-reduced-level (org-outline-level)) ? ))
- (looking-at "\\*+[ \t]+\\(.*\\)")
- (setq head (match-string 1))
- (let ((remove-re
- (if org-agenda-remove-timeranges-from-blocks
- (concat
- "<" (regexp-quote s1) ".*?>"
- "--"
- "<" (regexp-quote s2) ".*?>")
- nil)))
- (setq txt (org-agenda-format-item
- (format
- (nth (if (= d1 d2) 0 1)
- org-agenda-timerange-leaders)
- (1+ (- d0 d1)) (1+ (- d2 d1)))
- head level category tags
- (cond ((and (= d1 d0) (= d2 d0))
- (concat "<" start-time ">--<" end-time ">"))
- ((= d1 d0)
- (concat "<" start-time ">"))
- ((= d2 d0)
- (concat "<" end-time ">")))
- remove-re))))
- (org-add-props txt props
- 'org-marker marker 'org-hd-marker hdmarker
- 'type "block" 'date date
- 'level level
- 'todo-state todo-state
- 'priority (org-get-priority txt))
- (push txt ee))))
- (goto-char pos)))
- ;; Sort the entries by expiration date.
- (nreverse ee)))
+
;;; Agenda presentation and sorting
(defvar org-prefix-has-time nil
@@ -8197,8 +8337,9 @@ log items, nothing else."
((equal special '(16)) 'only)
((eq special 'clockcheck)
(if (eq org-agenda-show-log 'clockcheck)
- nil 'clockcheck))
- (special '(closed clock state))
+ nil
+ 'clockcheck))
+ (special '(:clock :closed :state))
(t (not org-agenda-show-log))))
(setq org-agenda-start-with-log-mode org-agenda-show-log)
(org-agenda-set-mode-name)
@@ -10119,9 +10260,9 @@ expression, and filter out entries that don't match it.
If FILTER is a string, use this string as a regular expression
for filtering entries out.
-If FILTER is a function, filter out entries against which
-calling the function returns nil. This function takes one
-argument: an entry from `org-agenda-get-day-entries'.
+If FILTER is a function, filter out entries against which calling
+the function returns nil. This function takes one argument: an
+entry from `org-agenda-day-entries'.
FILTER can also be an alist with the car of each cell being
either `headline' or `category'. For example:
@@ -10154,16 +10295,17 @@ to override `appt-message-warning-time'."
(today (org-date-to-gregorian
(time-to-days (current-time))))
(org-agenda-restrict nil)
- (files (org-agenda-files 'unrestricted)) entries file
+ (entries nil)
(org-agenda-buffer nil))
;; Get all entries which may contain an appt
- (org-agenda-prepare-buffers files)
- (while (setq file (pop files))
- (setq entries
- (delq nil
- (append entries
- (apply 'org-agenda-get-day-entries
- file today scope)))))
+ (let ((files (org-agenda-files 'unrestricted)))
+ (org-agenda-prepare-buffers files)
+ (dolist (file files)
+ (let ((items (org-agenda--file-data file scope)))
+ (setq entries
+ (append entries
+ (apply #'org-agenda-day-entries
+ today file items scope))))))
;; Map thru entries and find if we should filter them out
(mapc
(lambda (x)
diff --git a/lisp/org.el b/lisp/org.el
index 491649e2d..abd02d02f 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -4423,7 +4423,7 @@ This is needed for font-lock setup.")
(newhead hdmarker &optional fixface just-this))
(declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
"org-agenda"
- (&optional end))
+ (&optional scheduled deadline timestamp))
(declare-function org-agenda-copy-local-variable "org-agenda" (var))
(declare-function org-agenda-format-item
"org-agenda"
--
2.14.1