From: Nicolas Goaziou <mail@nicolasgoaziou.fr>
To: Org Mode List <emacs-orgmode@gnu.org>
Subject: [ANN] Agenda speed up
Date: Sun, 27 Aug 2017 18:16:50 +0200 [thread overview]
Message-ID: <87h8wtugst.fsf@nicolasgoaziou.fr> (raw)
[-- Attachment #1: Type: text/plain, Size: 1136 bytes --]
Hello,
I rewrote the part responsible for agenda generation in "org-agenda.el".
Basically, I refactored some hot loops and introduced a cache mechanism
for data extracted out of agenda files.
I expect to see some interesting improvements when viewing the agenda
with a span larger than one day, or when generating an agenda view
without having touched most of the agenda files since last view.
Some feedback about the new agenda speed would be nice.
Also, I certainly broke a few things along the way. Please report
anything suspicious.
The only thing that is expected to be defective is
`org-agenda-include-inactive-timestamps'. It has no effect at the
moment. I can activate it again, but I'm wondering if it's worth the
overhead. It is already possible to display clocks and closed timestamps
in the agenda. Other inactive timestamps could be ignored from the
agenda altogether. This is their sole purpose, after all. WDYT?
I attach the behemoth patch here for quick testing. Further bug fixes
will happen in "wip-agenda-speedup" branch.
Regards,
--
Nicolas Goaziou 0x80A93738
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Speed-up-Agenda-generation.patch --]
[-- Type: text/x-diff, Size: 110841 bytes --]
From f5dc1c8c5a439d93162598b25e6744ffee81af3a Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <mail@nicolasgoaziou.fr>
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.
\\<org-agenda-mode-map>\
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)
-
+\f
;;; 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)))
+\f
;;; 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
next reply other threads:[~2017-08-27 16:17 UTC|newest]
Thread overview: 42+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-08-27 16:16 Nicolas Goaziou [this message]
2017-08-27 16:22 ` [ANN] Agenda speed up Nicolas Goaziou
2017-08-27 20:05 ` Samuel Wales
2017-08-31 17:17 ` Nicolas Goaziou
2017-08-27 20:53 ` Russell Adams
2017-08-28 8:32 ` Colin Baxter
2017-08-28 10:12 ` Eric S Fraga
2017-08-28 14:24 ` Nicolas Goaziou
2017-08-29 6:52 ` Eric S Fraga
2017-08-29 15:56 ` Robert Horn
2017-08-29 8:06 ` Eric S Fraga
2017-08-30 9:00 ` Nicolas Goaziou
2017-08-30 9:41 ` Eric S Fraga
2017-08-30 15:00 ` Nicolas Goaziou
2017-08-30 15:37 ` Eric S Fraga
2017-08-30 9:42 ` Eric S Fraga
2017-09-29 20:45 ` Nicolas Goaziou
2017-09-29 20:56 ` Samuel Wales
2017-09-30 8:55 ` Nicolas Goaziou
2017-09-30 19:03 ` Matt Lundin
2017-10-01 17:33 ` Nicolas Goaziou
2017-10-01 17:57 ` Samuel Wales
2017-10-01 17:58 ` Samuel Wales
2017-10-01 22:59 ` Nicolas Goaziou
2017-10-01 23:49 ` Matt Lundin
2017-09-30 3:20 ` Kyle Meyer
2017-10-02 13:41 ` Nicolas Goaziou
2017-10-05 14:48 ` Kyle Meyer
2017-09-30 18:54 ` Matt Lundin
2017-09-30 19:53 ` Matt Lundin
2017-10-01 17:13 ` Nicolas Goaziou
2017-10-02 0:11 ` Matt Lundin
2017-10-02 0:39 ` Samuel Wales
2017-10-02 15:46 ` Nicolas Goaziou
2017-10-02 18:11 ` Marco Wahl
2017-10-03 9:35 ` Nicolas Goaziou
2017-10-03 10:23 ` Marco Wahl
2017-10-02 20:39 ` Samuel Wales
2017-10-03 9:36 ` Nicolas Goaziou
2017-10-03 23:45 ` Samuel Wales
2017-10-04 0:05 ` Samuel Wales
2017-10-02 15:28 ` Nicolas Goaziou
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87h8wtugst.fsf@nicolasgoaziou.fr \
--to=mail@nicolasgoaziou.fr \
--cc=emacs-orgmode@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).