Browse Source

org-agenda.el: New agenda entry types :scheduled* and :deadline*

* org.el (org-deadline-time-hour-regexp)
(org-scheduled-time-hour-regexp): New buffer local variables.
(org-set-regexps-and-options): Set the new variables.

* org-agenda.el (org-agenda-custom-commands-local-options):
Add :deadline* and :scheduled* to the list of possible agenda
entry types.
(org-agenda): Implement a new agenda type agenda* with :scheduled*
and :deadline* replacing :scheduled and :deadline respectively in
agenda entry types.  In such agenda, only scheduled and deadline
items with a time specification [h]h:mm will be considered.
(org-agenda-entry-types): Document the new agenda entry types
:scheduled* and :deadline*.
(org-agenda-list): New parameter `with-hour'.  Use :scheduled* and
:deadline*.
(org-agenda-get-day-entries): Handle :scheduled* and :deadline*.
(org-agenda-get-deadlines, org-agenda-get-scheduled): New
parameter `with-hour'.  Use `org-deadline-time-hour-regexp' or
`org-scheduled-time-hour-regexp' as the search string if needed.
(org-agenda-to-appt): Use :scheduled* and :deadline* by default,
as other scheduled and deadline items don't have a time spec and
cannot be turned into appointments.  Trim bracket links and use
only the description as the appointment text.
(org-agenda-get-restriction-and-command): Add
default description for the agenda* view.
(org-agenda-run-series): Handle agenda* views.
Bastien Guerry 12 years ago
parent
commit
df31fe6bdd
2 changed files with 95 additions and 27 deletions
  1. 83 27
      lisp/org-agenda.el
  2. 12 0
      lisp/org.el

+ 83 - 27
lisp/org-agenda.el

@@ -329,6 +329,8 @@ you can \"misuse\" it to also add other text to the header."
 			  (set :greedy t :value (:deadline :scheduled :timestamp :sexp)
 			  (set :greedy t :value (:deadline :scheduled :timestamp :sexp)
 			       (const :deadline)
 			       (const :deadline)
 			       (const :scheduled)
 			       (const :scheduled)
+			       (const :deadline*)
+			       (const :scheduled*)
 			       (const :timestamp)
 			       (const :timestamp)
 			       (const :sexp))))
 			       (const :sexp))))
 		   (list :tag "Standard skipping condition"
 		   (list :tag "Standard skipping condition"
@@ -2709,6 +2711,8 @@ Pressing `<' twice means to restrict to the current subtree or region
 	      (cond
 	      (cond
 	       ((eq type 'agenda)
 	       ((eq type 'agenda)
 		(org-let lprops '(org-agenda-list current-prefix-arg)))
 		(org-let lprops '(org-agenda-list current-prefix-arg)))
+	       ((eq type 'agenda*)
+		(org-let lprops '(org-agenda-list current-prefix-arg nil nil t)))
 	       ((eq type 'alltodo)
 	       ((eq type 'alltodo)
 		(org-let lprops '(org-todo-list current-prefix-arg)))
 		(org-let lprops '(org-todo-list current-prefix-arg)))
 	       ((eq type 'search)
 	       ((eq type 'search)
@@ -2866,6 +2870,7 @@ L   Timeline for current buffer         #   List stuck projects (!=configure)
 		     (cond
 		     (cond
 		      ((string-match "\\S-" desc) desc)
 		      ((string-match "\\S-" desc) desc)
 		      ((eq type 'agenda) "Agenda for current week or day")
 		      ((eq type 'agenda) "Agenda for current week or day")
+		      ((eq type 'agenda*) "Appointments for current week or day")
 		      ((eq type 'alltodo) "List of all TODO entries")
 		      ((eq type 'alltodo) "List of all TODO entries")
 		      ((eq type 'search) "Word search")
 		      ((eq type 'search) "Word search")
 		      ((eq type 'stuck) "List of stuck projects")
 		      ((eq type 'stuck) "List of stuck projects")
@@ -3028,6 +3033,9 @@ L   Timeline for current buffer         #   List stuck projects (!=configure)
 	 ((eq type 'agenda)
 	 ((eq type 'agenda)
 	  (org-let2 gprops lprops
 	  (org-let2 gprops lprops
 	    '(call-interactively 'org-agenda-list)))
 	    '(call-interactively 'org-agenda-list)))
+	 ((eq type 'agenda*)
+	  (org-let2 gprops lprops
+	    '(funcall 'org-agenda-list nil nil t)))
 	 ((eq type 'alltodo)
 	 ((eq type 'alltodo)
 	  (org-let2 gprops lprops
 	  (org-let2 gprops lprops
 	    '(call-interactively 'org-todo-list)))
 	    '(call-interactively 'org-todo-list)))
@@ -4058,24 +4066,33 @@ This variable is a list of symbols that controls the types of
 items that appear in the daily/weekly agenda.  Allowed symbols in this
 items that appear in the daily/weekly agenda.  Allowed symbols in this
 list are are
 list are are
 
 
-   :timestamp    List items containing a date stamp or date range matching
-                 the selected date.  This includes sexp entries in
-                 angular brackets.
+  :timestamp   List items containing a date stamp or date range matching
+               the selected date.  This includes sexp entries in angular
+               brackets.
+
+  :sexp        List entries resulting from plain diary-like sexps.
 
 
-   :sexp         List entries resulting from plain diary-like sexps.
+  :deadline    List deadline due on that date.  When the date is today,
+               also list any deadlines past due, or due within
+	       `org-deadline-warning-days'.  `:deadline' must appear before
+               `:scheduled' if the setting of
+               `org-agenda-skip-scheduled-if-deadline-is-shown' is to have
+               any effect.
 
 
-   :deadline     List deadline due on that date.  When the date is today,
-                 also list any deadlines past due, or due within
-		 `org-deadline-warning-days'.  `:deadline' must appear before
-                 `:scheduled' if the setting of
-                 `org-agenda-skip-scheduled-if-deadline-is-shown' is to have
-                 any effect.
+  :deadline*   Same as above, but only include the deadline if it has an
+               hour specification as [h]h:mm.
 
 
-   :scheduled    List all items which are scheduled for the given date.
-		 The diary for *today* also contains items which were
-		 scheduled earlier and are not yet marked DONE.
+  :scheduled   List all items which are scheduled for the given date.
+	       The diary for *today* also contains items which were
+	       scheduled earlier and are not yet marked DONE.
 
 
-By default, all four types are turned on.
+  :scheduled*  Same as above, but only include the scheduled item if it
+               has an hour specification as [h]h:mm.
+
+By default, all four non-starred types are turned on.
+
+When :scheduled* or :deadline* are included, :schedule or :deadline
+will be ignored.
 
 
 Never set this variable globally using `setq', because then it
 Never set this variable globally using `setq', because then it
 will apply to all future agenda commands.  Instead, bind it with
 will apply to all future agenda commands.  Instead, bind it with
@@ -4087,7 +4104,7 @@ the daily/weekly agenda, see `org-agenda-skip-function'.")
 
 
 (defvar org-agenda-buffer-tmp-name nil)
 (defvar org-agenda-buffer-tmp-name nil)
 ;;;###autoload
 ;;;###autoload
-(defun org-agenda-list (&optional arg start-day span)
+(defun org-agenda-list (&optional arg start-day span with-hour)
   "Produce a daily/weekly view from all files in variable `org-agenda-files'.
   "Produce a daily/weekly view from all files in variable `org-agenda-files'.
 The view will be for the current day or week, but from the overview buffer
 The view will be for the current day or week, but from the overview buffer
 you will be able to go to other days/weeks.
 you will be able to go to other days/weeks.
@@ -4097,7 +4114,10 @@ span ARG days.  Lisp programs should instead specify SPAN to change
 the number of days.  SPAN defaults to `org-agenda-span'.
 the number of days.  SPAN defaults to `org-agenda-span'.
 
 
 START-DAY defaults to TODAY, or to the most recent match for the weekday
 START-DAY defaults to TODAY, or to the most recent match for the weekday
-given in `org-agenda-start-on-weekday'."
+given in `org-agenda-start-on-weekday'.
+
+When WITH-HOUR is non-nil, only include scheduled and deadline
+items if they have an hour specification like [h]h:mm."
   (interactive "P")
   (interactive "P")
   (if org-agenda-overriding-arguments
   (if org-agenda-overriding-arguments
       (setq arg (car org-agenda-overriding-arguments)
       (setq arg (car org-agenda-overriding-arguments)
@@ -4147,7 +4167,7 @@ given in `org-agenda-start-on-weekday'."
 	   s e rtn rtnall file date d start-pos end-pos todayp
 	   s e rtn rtnall file date d start-pos end-pos todayp
 	   clocktable-start clocktable-end filter)
 	   clocktable-start clocktable-end filter)
       (setq org-agenda-redo-command
       (setq org-agenda-redo-command
-	    (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span)))
+	    (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span) with-hour))
       (dotimes (n (1- ndays))
       (dotimes (n (1- ndays))
 	(push (1+ (car day-numbers)) day-numbers))
 	(push (1+ (car day-numbers)) day-numbers))
       (setq day-numbers (nreverse day-numbers))
       (setq day-numbers (nreverse day-numbers))
@@ -4190,9 +4210,26 @@ given in `org-agenda-start-on-weekday'."
 	  (catch 'nextfile
 	  (catch 'nextfile
 	    (org-check-agenda-file file)
 	    (org-check-agenda-file file)
 	    (let ((org-agenda-entry-types org-agenda-entry-types))
 	    (let ((org-agenda-entry-types org-agenda-entry-types))
-	      (unless org-agenda-include-deadlines
+	      ;; Starred types override non-starred equivalents
+	      (when (member :deadline* org-agenda-entry-types)
 		(setq org-agenda-entry-types
 		(setq org-agenda-entry-types
 		      (delq :deadline 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
 	      (cond
 	       ((memq org-agenda-show-log-scoped '(only clockcheck))
 	       ((memq org-agenda-show-log-scoped '(only clockcheck))
 		(setq rtn (org-agenda-get-day-entries
 		(setq rtn (org-agenda-get-day-entries
@@ -5242,12 +5279,19 @@ the documentation of `org-diary'."
 		 ((eq arg :scheduled)
 		 ((eq arg :scheduled)
 		  (setq rtn (org-agenda-get-scheduled deadline-results))
 		  (setq rtn (org-agenda-get-scheduled deadline-results))
 		  (setq results (append results rtn)))
 		  (setq results (append results rtn)))
+		 ((eq arg :scheduled*)
+		  (setq rtn (org-agenda-get-scheduled deadline-results t))
+		  (setq results (append results rtn)))
 		 ((eq arg :closed)
 		 ((eq arg :closed)
 		  (setq rtn (org-agenda-get-progress))
 		  (setq rtn (org-agenda-get-progress))
 		  (setq results (append results rtn)))
 		  (setq results (append results rtn)))
 		 ((eq arg :deadline)
 		 ((eq arg :deadline)
 		  (setq rtn (org-agenda-get-deadlines))
 		  (setq rtn (org-agenda-get-deadlines))
 		  (setq deadline-results (copy-sequence rtn))
 		  (setq deadline-results (copy-sequence rtn))
+		  (setq results (append results rtn)))
+		 ((eq arg :deadline*)
+		  (setq rtn (org-agenda-get-deadlines t))
+		  (setq deadline-results (copy-sequence rtn))
 		  (setq results (append results rtn))))))))
 		  (setq results (append results rtn))))))))
 	results))))
 	results))))
 
 
@@ -5908,8 +5952,10 @@ See also the user option `org-agenda-clock-consistency-checks'."
       ;; Nope, this gap is not OK
       ;; Nope, this gap is not OK
       nil)))
       nil)))
 
 
-(defun org-agenda-get-deadlines ()
-  "Return the deadline information for agenda display."
+(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
   (let* ((props (list 'mouse-face 'highlight
 		      'org-not-done-regexp org-not-done-regexp
 		      'org-not-done-regexp org-not-done-regexp
 		      'org-todo-regexp org-todo-regexp
 		      'org-todo-regexp org-todo-regexp
@@ -5917,7 +5963,9 @@ See also the user option `org-agenda-clock-consistency-checks'."
 		      'help-echo
 		      'help-echo
 		      (format "mouse-2 or RET jump to org file %s"
 		      (format "mouse-2 or RET jump to org file %s"
 			      (abbreviate-file-name buffer-file-name))))
 			      (abbreviate-file-name buffer-file-name))))
-	 (regexp org-deadline-time-regexp)
+	 (regexp (if with-hour
+		     org-deadline-time-hour-regexp
+		   org-deadline-time-regexp))
 	 (todayp (org-agenda-todayp date)) ; DATE bound by calendar
 	 (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
 	 (dl0 (car org-agenda-deadline-leaders))
 	 (dl0 (car org-agenda-deadline-leaders))
@@ -6047,8 +6095,10 @@ FRACTION is what fraction of the head-warning time has passed."
       (while (setq f (pop faces))
       (while (setq f (pop faces))
 	(if (>= fraction (car f)) (throw 'exit (cdr f)))))))
 	(if (>= fraction (car f)) (throw 'exit (cdr f)))))))
 
 
-(defun org-agenda-get-scheduled (&optional deadline-results)
-  "Return the scheduled information for agenda display."
+(defun org-agenda-get-scheduled (&optional deadline-results with-hour)
+  "Return the scheduled information for agenda display.
+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
   (let* ((props (list 'org-not-done-regexp org-not-done-regexp
 		      'org-todo-regexp org-todo-regexp
 		      'org-todo-regexp org-todo-regexp
 		      'org-complex-heading-regexp org-complex-heading-regexp
 		      'org-complex-heading-regexp org-complex-heading-regexp
@@ -6057,7 +6107,9 @@ FRACTION is what fraction of the head-warning time has passed."
 		      'help-echo
 		      'help-echo
 		      (format "mouse-2 or RET jump to org file %s"
 		      (format "mouse-2 or RET jump to org file %s"
 			      (abbreviate-file-name buffer-file-name))))
 			      (abbreviate-file-name buffer-file-name))))
-	 (regexp org-scheduled-time-regexp)
+	 (regexp (if with-hour
+		     org-scheduled-time-hour-regexp
+		   org-scheduled-time-regexp))
 	 (todayp (org-agenda-todayp date)) ; DATE bound by calendar
 	 (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
 	 mm
@@ -9763,7 +9815,8 @@ will only add headlines containing IMPORTANT or headlines
 belonging to the \"Work\" category.
 belonging to the \"Work\" category.
 
 
 ARGS are symbols indicating what kind of entries to consider.
 ARGS are symbols indicating what kind of entries to consider.
-By default `org-agenda-to-appt' will use :deadline, :scheduled
+By default `org-agenda-to-appt' will use :deadline*, :scheduled*
+\(i.e., deadlines and scheduled items with a hh:mm specification)
 and :timestamp entries.  See the docstring of `org-diary' for
 and :timestamp entries.  See the docstring of `org-diary' for
 details and examples.
 details and examples.
 
 
@@ -9774,7 +9827,7 @@ to override `appt-message-warning-time'."
   (if (eq filter t)
   (if (eq filter t)
       (setq filter (read-from-minibuffer "Regexp filter: ")))
       (setq filter (read-from-minibuffer "Regexp filter: ")))
   (let* ((cnt 0) ; count added events
   (let* ((cnt 0) ; count added events
-	 (scope (or args '(:deadline :scheduled :timestamp)))
+	 (scope (or args '(:deadline* :scheduled* :timestamp)))
 	 (org-agenda-new-buffers nil)
 	 (org-agenda-new-buffers nil)
 	 (org-deadline-warning-days 0)
 	 (org-deadline-warning-days 0)
 	 ;; Do not use `org-today' here because appt only takes
 	 ;; Do not use `org-today' here because appt only takes
@@ -9796,7 +9849,10 @@ to override `appt-message-warning-time'."
     ;; Map thru entries and find if we should filter them out
     ;; Map thru entries and find if we should filter them out
     (mapc
     (mapc
      (lambda(x)
      (lambda(x)
-       (let* ((evt (org-trim (or (get-text-property 1 'txt x) "")))
+       (let* ((evt (org-trim
+		    (replace-regexp-in-string
+		     org-bracket-link-regexp "\\3"
+		     (or (get-text-property 1 'txt x) ""))))
 	      (cat (get-text-property 1 'org-category x))
 	      (cat (get-text-property 1 'org-category x))
 	      (tod (get-text-property 1 'time-of-day x))
 	      (tod (get-text-property 1 'time-of-day x))
 	      (ok (or (null filter)
 	      (ok (or (null filter)

+ 12 - 0
lisp/org.el

@@ -4571,6 +4571,9 @@ Also put tags into group 4 if tags are present.")
 (defvar org-deadline-time-regexp nil
 (defvar org-deadline-time-regexp nil
   "Matches the DEADLINE keyword together with a time stamp.")
   "Matches the DEADLINE keyword together with a time stamp.")
 (make-variable-buffer-local 'org-deadline-time-regexp)
 (make-variable-buffer-local 'org-deadline-time-regexp)
+(defvar org-deadline-time-hour-regexp nil
+  "Matches the DEADLINE keyword together with a time-and-hour stamp.")
+(make-variable-buffer-local 'org-deadline-time-hour-regexp)
 (defvar org-deadline-line-regexp nil
 (defvar org-deadline-line-regexp nil
   "Matches the DEADLINE keyword and the rest of the line.")
   "Matches the DEADLINE keyword and the rest of the line.")
 (make-variable-buffer-local 'org-deadline-line-regexp)
 (make-variable-buffer-local 'org-deadline-line-regexp)
@@ -4580,6 +4583,9 @@ Also put tags into group 4 if tags are present.")
 (defvar org-scheduled-time-regexp nil
 (defvar org-scheduled-time-regexp nil
   "Matches the SCHEDULED keyword together with a time stamp.")
   "Matches the SCHEDULED keyword together with a time stamp.")
 (make-variable-buffer-local 'org-scheduled-time-regexp)
 (make-variable-buffer-local 'org-scheduled-time-regexp)
+(defvar org-scheduled-time-hour-regexp nil
+  "Matches the SCHEDULED keyword together with a time-and-hour stamp.")
+(make-variable-buffer-local 'org-scheduled-time-hour-regexp)
 (defvar org-closed-time-regexp nil
 (defvar org-closed-time-regexp nil
   "Matches the CLOSED keyword together with a time stamp.")
   "Matches the CLOSED keyword together with a time stamp.")
 (make-variable-buffer-local 'org-closed-time-regexp)
 (make-variable-buffer-local 'org-closed-time-regexp)
@@ -4988,12 +4994,18 @@ but the stars and the body are.")
 	    org-deadline-regexp (concat "\\<" org-deadline-string)
 	    org-deadline-regexp (concat "\\<" org-deadline-string)
 	    org-deadline-time-regexp
 	    org-deadline-time-regexp
 	    (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")
 	    (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")
+	    org-deadline-time-hour-regexp
+	    (concat "\\<" org-deadline-string
+		    " *<\\(.+[0-9]\\{1,2\\}:[0-9]\\{2\\}[^>]*\\)>")
 	    org-deadline-line-regexp
 	    org-deadline-line-regexp
 	    (concat "\\<\\(" org-deadline-string "\\).*")
 	    (concat "\\<\\(" org-deadline-string "\\).*")
 	    org-scheduled-regexp
 	    org-scheduled-regexp
 	    (concat "\\<" org-scheduled-string)
 	    (concat "\\<" org-scheduled-string)
 	    org-scheduled-time-regexp
 	    org-scheduled-time-regexp
 	    (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")
 	    (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")
+	    org-scheduled-time-hour-regexp
+	    (concat "\\<" org-scheduled-string
+		    " *<\\(.+[0-9]\\{1,2\\}:[0-9]\\{2\\}[^>]*\\)>")
 	    org-closed-time-regexp
 	    org-closed-time-regexp
 	    (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]")
 	    (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]")
 	    org-keyword-time-regexp
 	    org-keyword-time-regexp