[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [O] [BUG] Entries from Org code blocks appear in agenda
|
From: |
Nicolas Goaziou |
|
Subject: |
Re: [O] [BUG] Entries from Org code blocks appear in agenda |
|
Date: |
Thu, 04 Sep 2014 21:45:56 +0200 |
Hello,
"Francesco Pizzolante"
<fpz-djc/address@hidden> writes:
> I noticed that entries from Org code blocks are erroneously displayed in
> the agenda.
>
> Here's a very simple Org example in order to reproduce it
> (my-simple-test.org):
>
> * Test
>
> #+BEGIN_SRC org ,SCHEDULED: <2014-09-04 Thu 10:00> #+END_SRC
This is a known bug that would require to use the parser in
"org-agenda.el" for a proper fix.
Meanwhile, I wrote a workaround. Would you mind testing it (note: it
applies on maint, probably not on master without conflicts).
Regards,
--
Nicolas Goaziou
>From fad280debe2dd1cb59071f258153004f1dffd51e Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <address@hidden>
Date: Thu, 4 Sep 2014 21:41:40 +0200
Subject: [PATCH] org-agenda: Prevent false positive SCHEDULED entries
---
lisp/org-agenda.el | 292 ++++++++++++++++++++++++++---------------------------
lisp/org.el | 82 +++++++++------
2 files changed, 195 insertions(+), 179 deletions(-)
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 4b6385b..3d6ecac 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -6143,7 +6143,7 @@ an hour specification like [h]h:mm."
org-scheduled-time-hour-regexp
org-scheduled-time-regexp))
(todayp (org-agenda-todayp date)) ; DATE bound by calendar
- (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
+ (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
mm
(deadline-position-alist
(mapcar (lambda (a) (and (setq mm (get-text-property
@@ -6156,153 +6156,153 @@ an hour specification like [h]h:mm."
ddays)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
- (catch :skip
- (org-agenda-skip)
- (setq s (match-string 1)
- txt nil
- pos (1- (match-beginning 1))
- todo-state (save-match-data (org-get-todo-state))
- show-all (or (eq org-agenda-repeating-timestamp-show-all t)
- (member todo-state
- org-agenda-repeating-timestamp-show-all))
- d2 (org-time-string-to-absolute
- s d1 'past show-all (current-buffer) pos)
- diff (- d2 d1)
- warntime (get-text-property (point) 'org-appt-warntime))
- (setq pastschedp (and todayp (< diff 0)))
- (setq did-habit-check-p nil)
- (setq suppress-delay
- (let ((ds (and org-agenda-skip-scheduled-delay-if-deadline
- (let ((item (buffer-substring (point-at-bol)
(point-at-eol))))
- (save-match-data
- (and (string-match
- org-deadline-time-regexp item)
- (match-string 1 item)))))))
- (cond
- ((not ds) nil)
- ;; The current item has a deadline date (in ds), 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 (- d2 (org-time-string-to-absolute
- ds d1 'past show-all (current-buffer) pos))
- org-scheduled-delay-days))
- (t 0))))
- (setq ddays (if suppress-delay
- (let ((org-scheduled-delay-days suppress-delay))
- (org-get-wdays s t t))
- (org-get-wdays s t)))
- ;; Use a delay of 0 when there is a repeater and the delay is
- ;; of the form --3d
- (when (and (save-match-data (string-match "--[0-9]+[hdwmy]" s))
- (< (org-time-string-to-absolute s)
- (org-time-string-to-absolute
- s d2 'past nil (current-buffer) pos)))
- (setq ddays 0))
- ;; When to show a scheduled item in the calendar:
- ;; If it is on or past the date.
- (when (or (and (> ddays 0) (= diff (- ddays)))
- (and (zerop ddays) (= diff 0))
- (and (< (+ diff ddays) 0)
- (< (abs diff) org-scheduled-past-days)
- (and todayp (not org-agenda-only-exact-dates)))
- ;; org-is-habit-p uses org-entry-get, which is expansive
- ;; so we go extra mile to only call it once
- (and todayp
- (boundp 'org-habit-show-all-today)
- org-habit-show-all-today
- (setq did-habit-check-p t)
- (setq habitp (and (functionp 'org-is-habit-p)
- (org-is-habit-p)))))
- (save-excursion
- (setq donep (member todo-state org-done-keywords))
- (if (and donep
- (or org-agenda-skip-scheduled-if-done
- (not (= diff 0))
- (and (functionp 'org-is-habit-p)
- (org-is-habit-p))))
- (setq txt nil)
- (setq habitp (if did-habit-check-p habitp
+ (let ((s (save-match-data (org-entry-get (point) "SCHEDULED"))))
+ (when s
+ (catch :skip
+ (org-agenda-skip)
+ (setq txt nil
+ pos (1- (match-beginning 1))
+ todo-state (save-match-data (org-get-todo-state))
+ show-all (or (eq org-agenda-repeating-timestamp-show-all t)
+ (member todo-state
+ org-agenda-repeating-timestamp-show-all))
+ d2 (org-time-string-to-absolute
+ s d1 'past show-all (current-buffer) pos)
+ diff (- d2 d1)
+ warntime (get-text-property (point) 'org-appt-warntime))
+ (setq pastschedp (and todayp (< diff 0)))
+ (setq did-habit-check-p nil)
+ (setq suppress-delay
+ (let ((ds (and org-agenda-skip-scheduled-delay-if-deadline
+ (let ((item (buffer-substring (point-at-bol)
(point-at-eol))))
+ (save-match-data
+ (and (string-match
+ org-deadline-time-regexp item)
+ (match-string 1 item)))))))
+ (cond
+ ((not ds) nil)
+ ;; The current item has a deadline date (in ds), 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 (- d2 (org-time-string-to-absolute
+ ds d1 'past show-all (current-buffer) pos))
+ org-scheduled-delay-days))
+ (t 0))))
+ (setq ddays (if suppress-delay
+ (let ((org-scheduled-delay-days suppress-delay))
+ (org-get-wdays s t t))
+ (org-get-wdays s t)))
+ ;; Use a delay of 0 when there is a repeater and the delay is
+ ;; of the form --3d
+ (when (and (save-match-data (string-match "--[0-9]+[hdwmy]" s))
+ (< (org-time-string-to-absolute s)
+ (org-time-string-to-absolute
+ s d2 'past nil (current-buffer) pos)))
+ (setq ddays 0))
+ ;; When to show a scheduled item in the calendar:
+ ;; If it is on or past the date.
+ (when (or (and (> ddays 0) (= diff (- ddays)))
+ (and (zerop ddays) (= diff 0))
+ (and (< (+ diff ddays) 0)
+ (< (abs diff) org-scheduled-past-days)
+ (and todayp (not org-agenda-only-exact-dates)))
+ ;; org-is-habit-p uses org-entry-get, which is expansive
+ ;; so we go extra mile to only call it once
+ (and todayp
+ (boundp 'org-habit-show-all-today)
+ org-habit-show-all-today
+ (setq did-habit-check-p t)
+ (setq habitp (and (functionp 'org-is-habit-p)
+ (org-is-habit-p)))))
+ (save-excursion
+ (setq donep (member todo-state org-done-keywords))
+ (if (and donep
+ (or org-agenda-skip-scheduled-if-done
+ (not (= diff 0))
(and (functionp 'org-is-habit-p)
(org-is-habit-p))))
- (setq category (org-get-category)
- category-pos (get-text-property (point)
'org-category-position))
- (if (and (eq org-agenda-skip-scheduled-if-deadline-is-shown
- 'repeated-after-deadline)
- (org-get-deadline-time (point))
- (<= 0 (- d2 (time-to-days (org-get-deadline-time
(point))))))
- (throw :skip nil))
- (if (not (re-search-backward "^\\*+[ \t]+" nil t))
- (throw :skip nil)
- (goto-char (match-end 0))
- (setq pos1 (match-beginning 0))
- (if habitp
- (if (or (not org-habit-show-habits)
- (and (not todayp)
- (boundp 'org-habit-show-habits-only-for-today)
- org-habit-show-habits-only-for-today))
- (throw :skip nil))
- (if (and
- (or (eq t org-agenda-skip-scheduled-if-deadline-is-shown)
- (and (eq
org-agenda-skip-scheduled-if-deadline-is-shown 'not-today)
- pastschedp))
- (setq mm (assoc pos1 deadline-position-alist)))
- (throw :skip nil)))
- (setq 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)) ? ))
- (setq head (buffer-substring
- (point)
- (progn (skip-chars-forward "^\r\n") (point))))
- (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
- (setq timestr
- (concat (substring s (match-beginning 1)) " "))
- (setq timestr 'time))
- (setq txt (org-agenda-format-item
- (if (= diff 0)
- (car org-agenda-scheduled-leaders)
- (format (nth 1 org-agenda-scheduled-leaders)
- (- 1 diff)))
- head level category tags
- (if (not (= diff 0)) nil timestr)
- nil habitp))))
- (when txt
- (setq 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 txt 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 pos1)
- 'type (if pastschedp "past-scheduled" "scheduled")
- 'date (if pastschedp d2 date)
- 'ts-date d2
- 'warntime warntime
- 'level level
- 'priority (if habitp
- (org-habit-get-priority habitp)
- (+ 94 (- 5 diff) (org-get-priority txt)))
- 'org-category category
- 'category-position category-pos
- 'org-habit-p habitp
- 'todo-state todo-state)
- (push txt ee))))))
+ (setq txt nil)
+ (setq habitp (if did-habit-check-p habitp
+ (and (functionp 'org-is-habit-p)
+ (org-is-habit-p))))
+ (setq category (org-get-category)
+ category-pos (get-text-property (point)
'org-category-position))
+ (if (and (eq org-agenda-skip-scheduled-if-deadline-is-shown
+ 'repeated-after-deadline)
+ (org-get-deadline-time (point))
+ (<= 0 (- d2 (time-to-days (org-get-deadline-time
(point))))))
+ (throw :skip nil))
+ (goto-char (match-end 0))
+ (setq pos1 (match-beginning 0))
+ (if habitp
+ (if (or (not org-habit-show-habits)
+ (and (not todayp)
+ (boundp
'org-habit-show-habits-only-for-today)
+ org-habit-show-habits-only-for-today))
+ (throw :skip nil))
+ (if (and
+ (or (eq t
org-agenda-skip-scheduled-if-deadline-is-shown)
+ (and (eq
org-agenda-skip-scheduled-if-deadline-is-shown 'not-today)
+ pastschedp))
+ (setq mm (assoc pos1 deadline-position-alist)))
+ (throw :skip nil)))
+ (setq 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)) ? ))
+ (setq head (buffer-substring
+ (point)
+ (progn (skip-chars-forward "^\r\n") (point))))
+ (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
+ (setq timestr
+ (concat (substring s (match-beginning 1)) " "))
+ (setq timestr 'time))
+ (setq txt (org-agenda-format-item
+ (if (= diff 0)
+ (car org-agenda-scheduled-leaders)
+ (format (nth 1 org-agenda-scheduled-leaders)
+ (- 1 diff)))
+ head level category tags
+ (if (not (= diff 0)) nil timestr)
+ nil habitp)))
+ (when txt
+ (setq 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 txt 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 pos1)
+ 'type (if pastschedp "past-scheduled" "scheduled")
+ 'date (if pastschedp d2 date)
+ 'ts-date d2
+ 'warntime warntime
+ 'level level
+ 'priority (if habitp
+ (org-habit-get-priority habitp)
+ (+ 94 (- 5 diff) (org-get-priority txt)))
+ 'org-category category
+ 'category-position category-pos
+ 'org-habit-p habitp
+ 'todo-state todo-state)
+ (push txt ee))))))
+ (outline-next-heading)))
(nreverse ee)))
(defun org-agenda-get-blocks ()
diff --git a/lisp/org.el b/lisp/org.el
index 1a6d028..43858fd 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -878,6 +878,14 @@ Changes become only effective after restarting Emacs."
:package-version '(Org . "8.0")
:type 'boolean)
+(defconst org-planning-line-re
+ (concat "^[ \t]*"
+ (regexp-opt
+ (list org-closed-string org-deadline-string org-scheduled-string)
+ t))
+ "Matches a line with planning info.
+Matched keyword is in group 1.")
+
(defconst org-planning-or-clock-line-re (concat "^[ \t]*\\("
org-scheduled-string "\\|"
org-deadline-string "\\|"
@@ -4662,6 +4670,19 @@ Also put tags into group 4 if tags are present.")
"List of time keywords.")
(make-variable-buffer-local 'org-all-time-keywords)
+(defconst org-clock-or-timestamp-regexp
+ (concat (format "\\(?:^[ \t]*%s *\\([[<][^]>]+[]>]\\)\\)" org-clock-string)
+ "\\|"
+ "\\("
+ "[[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?[]>]"
+ "\\|"
+ "<%%([^\r\n>]*>"
+ "\\)")
+ "Regexp matching a clock line or a timestamp.
+When matching a clock line, match group 1 contains clock's
+timestamp. Otherwise, match group 2 contains the regular
+timestamp matched.")
+
(defconst org-plain-time-of-day-regexp
(concat
"\\(\\<[012]?[0-9]"
@@ -15291,44 +15312,39 @@ things up because then unnecessary parsing is
avoided."
props))
(when (or (not specific) (string= specific "BLOCKED"))
(push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props))
+
(when (or (not specific)
- (member specific
- '("SCHEDULED" "DEADLINE" "CLOCK" "CLOSED"
- "TIMESTAMP" "TIMESTAMP_IA")))
+ (member specific '("SCHEDULED" "DEADLINE" "CLOSED")))
+ (forward-line)
+ (when (org-looking-at-p org-planning-line-re)
+ (catch 'match
+ (let ((end (line-end-position)))
+ (while (re-search-forward
+ org-keyword-time-not-clock-regexp end t)
+ (let ((keyword (match-string 1))
+ (timestamp (match-string 2)))
+ (push (cons keyword timestamp) props)
+ (when (and specific (equal keyword specific))
+ (throw 'match t))))))
+ (forward-line)))
+ (when (or (not specific)
+ (member specific '("CLOCK" "TIMESTAMP" "TIMESTAMP_IA")))
(catch 'match
- (while (and (re-search-forward org-maybe-keyword-time-regexp end
t)
+ (while (and (re-search-forward org-clock-or-timestamp-regexp end
t)
(not (text-property-any 0 (length (match-string 0))
'face 'font-lock-comment-face
(match-string 0))))
- (setq key (if (match-end 1)
- (substring (org-match-string-no-properties 1)
- 0 -1))
- string (if (equal key clockstr)
- (org-trim
- (buffer-substring-no-properties
- (match-beginning 3) (goto-char
- (point-at-eol))))
- (substring (org-match-string-no-properties 3)
- 1 -1)))
- ;; Get the correct property name from the key. This is
- ;; necessary if the user has configured time keywords.
- (setq key1 (concat key ":"))
- (cond
- ((not key)
- (setq key
- (if (= (char-after (match-beginning 3)) ?\[)
- "TIMESTAMP_IA" "TIMESTAMP")))
- ((equal key1 org-scheduled-string) (setq key "SCHEDULED"))
- ((equal key1 org-deadline-string) (setq key "DEADLINE"))
- ((equal key1 org-closed-string) (setq key "CLOSED"))
- ((equal key1 org-clock-string) (setq key "CLOCK")))
- (if (and specific (equal key specific) (not (equal key
"CLOCK")))
- (progn
- (push (cons key string) props)
- ;; no need to search further if match is found
- (throw 'match t))
- (when (or (equal key "CLOCK") (not (assoc key props)))
- (push (cons key string) props)))))))
+ (let ((key (cond ((match-beginning 1) "CLOCK")
+ ((= (char-after (match-beginning 2)) ?\[)
+ "TIMESTAMP_IA")
+ (t "TIMESTAMP")))
+ (value (or (match-string 1) (match-string 2))))
+ (cond
+ ((and specific (equal key specific) (not (equal key
"CLOCK")))
+ (push (cons key value) props)
+ (throw 'match t))
+ ((or (equal key "CLOCK") (not (assoc key props)))
+ (push (cons key value) props))))))))
(when (memq which '(all standard))
;; Get the standard properties, like :PROP: ...
--
2.1.0