Browse Source

New option `org-sparse-tree-default-date-type' to specify what is a "date" in `org-sparse-tree'.

* org.el (org-sparse-tree-default-date-type): New option.
(org-ts-type): New variable.
(org-sparse-tree): New argument `type'.  Use the new option
`org-sparse-tree-default-date-type' as the default value for
`type'.  Fix docstring.
(org-re-timestamp): New function.
(org-check-before-date, org-check-after-date)
(org-check-dates-range): Use `org-ts-type' and
`org-re-timestamp' to tell compute the date regexp.

Thanks to John Hendy who triggered this change.
Bastien Guerry 12 years ago
parent
commit
2959acb18c
1 changed files with 64 additions and 18 deletions
  1. 64 18
      lisp/org.el

+ 64 - 18
lisp/org.el

@@ -4262,6 +4262,25 @@ collapsed state."
   :group 'org-sparse-trees
   :group 'org-sparse-trees
   :type 'boolean)
   :type 'boolean)
 
 
+(defcustom org-sparse-tree-default-date-type 'scheduled-or-deadline
+  "The default date type when building a sparse tree.
+When this is nil, a date is a scheduled or a deadline timestamp.
+Otherwise, these types are allowed:
+
+        all: all timestamps
+     active: only active timestamps (<...>)
+   inactive: only inactive timestamps (<...)
+  scheduled: only scheduled timestamps
+   deadline: only deadline timestamps"
+  :type '(choice (const :tag "Scheduled or deadline" 'scheduled-or-deadline)
+		 (const :tag "All timestamps" all)
+		 (const :tag "Only active timestamps" active)
+		 (const :tag "Only inactive timestamps" inactive)
+		 (const :tag "Only scheduled timestamps" scheduled)
+		 (const :tag "Only deadline timestamps" deadline))
+  :group 'org-sparse-trees
+  :version "24.2")
+
 (defun org-cycle-hide-archived-subtrees (state)
 (defun org-cycle-hide-archived-subtrees (state)
   "Re-hide all archived subtrees after a visibility state change."
   "Re-hide all archived subtrees after a visibility state change."
   (when (and (not org-cycle-open-archived-trees)
   (when (and (not org-cycle-open-archived-trees)
@@ -12579,7 +12598,8 @@ POS may also be a marker."
 	     (concat "^[ \t]*:" drawer ":[ \t]*\n[ \t]*:END:[ \t]*\n?") 2)
 	     (concat "^[ \t]*:" drawer ":[ \t]*\n[ \t]*:END:[ \t]*\n?") 2)
 	    (replace-match ""))))))
 	    (replace-match ""))))))
 
 
-(defun org-sparse-tree (&optional arg)
+(defvar org-ts-type nil)
+(defun org-sparse-tree (&optional arg type)
   "Create a sparse tree, prompt for the details.
   "Create a sparse tree, prompt for the details.
 This command can create sparse trees.  You first need to select the type
 This command can create sparse trees.  You first need to select the type
 of match used to create the tree:
 of match used to create the tree:
@@ -12589,15 +12609,27 @@ T      Show entries with a specific TODO keyword.
 m      Show entries selected by a tags/property match.
 m      Show entries selected by a tags/property match.
 p      Enter a property name and its value (both with completion on existing
 p      Enter a property name and its value (both with completion on existing
        names/values) and show entries with that property.
        names/values) and show entries with that property.
-r      Show entries matching a regular expression (`/' can be used as well)
-d      Show deadlines due within `org-deadline-warning-days'.
+r      Show entries matching a regular expression (`/' can be used as well).
 b      Show deadlines and scheduled items before a date.
 b      Show deadlines and scheduled items before a date.
-a      Show deadlines and scheduled items after a date."
+a      Show deadlines and scheduled items after a date.
+d      Show deadlines due within `org-deadline-warning-days'.
+D      Show deadlines and scheduled items between a date range."
   (interactive "P")
   (interactive "P")
-  (let (ans kwd value)
-    (message "Sparse tree: [r]egexp [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty\n             [d]eadlines [b]efore-date [a]fter-date [D]ates range")
+  (let (ans kwd value ts-type)
+    (setq type (or type org-sparse-tree-default-date-type))
+    (setq org-ts-type type)
+    (message "Sparse tree: [r]egexp [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty\n             [d]eadlines [b]efore-date [a]fter-date [D]ates range\n             [c]ycle through date types: %s"
+	     (cond ((eq type 'all) "all timestamps")
+		   ((eq type 'scheduled) "only scheduled")
+		   ((eq type 'deadline) "only deadline")
+		   ((eq type 'active) "only active timestamps")
+		   ((eq type 'inactive) "only inactive timestamps")
+		   ((eq type 'scheduled-or-deadline) "scheduled/deadline")
+		   (t "scheduled/deadline")))
     (setq ans (read-char-exclusive))
     (setq ans (read-char-exclusive))
     (cond
     (cond
+     ((equal ans ?c)
+      (org-sparse-tree arg (cadr (member type '(scheduled-or-deadline all scheduled deadline active inactive)))))
      ((equal ans ?d)
      ((equal ans ?d)
       (call-interactively 'org-check-deadlines))
       (call-interactively 'org-check-deadlines))
      ((equal ans ?b)
      ((equal ans ?b)
@@ -15815,16 +15847,34 @@ days.  If the prefix is a raw \\[universal-argument] prefix, all deadlines are s
 	     (org-occur regexp nil callback)
 	     (org-occur regexp nil callback)
 	     org-warn-days)))
 	     org-warn-days)))
 
 
+(defsubst org-re-timestamp (type)
+  "Return a regexp for timestamp TYPE.
+Allowed values for TYPE are:
+
+        all: all timestamps
+     active: only active timestamps (<...>)
+   inactive: only inactive timestamps ([...])
+  scheduled: only scheduled timestamps
+   deadline: only deadline timestamps
+
+When TYPE is nil, fall back on returning a regexp that matches
+both scheduled and deadline timestamps."
+  (cond ((eq type 'all) "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\(?: +[^]+0-9>
\n -]+\\)?\\(?: +[0-9]\\{1,2\\}:[0-9]\\{2\\}\\)?\\)")
+	((eq type 'active) org-ts-regexp)
+	((eq type 'inactive) "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^
\n>]*?\\)\\]")
+	((eq type 'scheduled) (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>"))
+	((eq type 'deadline) (concat "\\<" org-deadline-string " *<\\([^>]+\\)>"))
+	((eq type 'scheduled-or-deadline)
+	 (concat "\\<\\(?:" org-deadline-string "\\|" org-scheduled-string "\\) *<\\([^>]+\\)>"))))
+
 (defun org-check-before-date (date)
 (defun org-check-before-date (date)
   "Check if there are deadlines or scheduled entries before DATE."
   "Check if there are deadlines or scheduled entries before DATE."
   (interactive (list (org-read-date)))
   (interactive (list (org-read-date)))
   (let ((case-fold-search nil)
   (let ((case-fold-search nil)
-	(regexp (concat "\\<\\(" org-deadline-string
-			"\\|" org-scheduled-string
-			"\\) *<\\([^>]+\\)>"))
+	(regexp (org-re-timestamp org-ts-type))
 	(callback
 	(callback
 	 (lambda () (time-less-p
 	 (lambda () (time-less-p
-		     (org-time-string-to-time (match-string 2))
+		     (org-time-string-to-time (match-string 1))
 		     (org-time-string-to-time date)))))
 		     (org-time-string-to-time date)))))
     (message "%d entries before %s"
     (message "%d entries before %s"
 	     (org-occur regexp nil callback) date)))
 	     (org-occur regexp nil callback) date)))
@@ -15833,13 +15883,11 @@ days.  If the prefix is a raw \\[universal-argument] prefix, all deadlines are s
   "Check if there are deadlines or scheduled entries after DATE."
   "Check if there are deadlines or scheduled entries after DATE."
   (interactive (list (org-read-date)))
   (interactive (list (org-read-date)))
   (let ((case-fold-search nil)
   (let ((case-fold-search nil)
-	(regexp (concat "\\<\\(" org-deadline-string
-			"\\|" org-scheduled-string
-			"\\) *<\\([^>]+\\)>"))
+	(regexp (org-re-timestamp org-ts-type))
 	(callback
 	(callback
 	 (lambda () (not
 	 (lambda () (not
 		     (time-less-p
 		     (time-less-p
-		      (org-time-string-to-time (match-string 2))
+		      (org-time-string-to-time (match-string 1))
 		      (org-time-string-to-time date))))))
 		      (org-time-string-to-time date))))))
     (message "%d entries after %s"
     (message "%d entries after %s"
 	     (org-occur regexp nil callback) date)))
 	     (org-occur regexp nil callback) date)))
@@ -15849,12 +15897,10 @@ days.  If the prefix is a raw \\[universal-argument] prefix, all deadlines are s
   (interactive (list (org-read-date nil nil nil "Range starts")
   (interactive (list (org-read-date nil nil nil "Range starts")
 		     (org-read-date nil nil nil "Range end")))
 		     (org-read-date nil nil nil "Range end")))
   (let ((case-fold-search nil)
   (let ((case-fold-search nil)
-	(regexp (concat "\\<\\(" org-deadline-string
-			"\\|" org-scheduled-string
-			"\\) *<\\([^>]+\\)>"))
+	(regexp (org-re-timestamp org-ts-type))
 	(callback
 	(callback
 	 (lambda ()
 	 (lambda ()
-	   (let ((match (match-string 2)))
+	   (let ((match (match-string 1)))
 	     (and
 	     (and
 	      (not (time-less-p
 	      (not (time-less-p
 		    (org-time-string-to-time match)
 		    (org-time-string-to-time match)