Browse Source

Agenda: Allow TODO conditions in the skip functions

Carsten Dominik 15 years ago
parent
commit
57148dd8aa
3 changed files with 81 additions and 1 deletions
  1. 4 0
      doc/org.texi
  2. 6 0
      lisp/ChangeLog
  3. 71 1
      lisp/org-agenda.el

+ 4 - 0
doc/org.texi

@@ -11883,6 +11883,10 @@ Skip current entry if it has not been scheduled.
 Skip current entry if it has a deadline.
 Skip current entry if it has a deadline.
 @item '(org-agenda-skip-entry-if 'scheduled 'deadline)
 @item '(org-agenda-skip-entry-if 'scheduled 'deadline)
 Skip current entry if it has a deadline, or if it is scheduled.
 Skip current entry if it has a deadline, or if it is scheduled.
+@item '(org-agenda-skip-entry-if 'todo '("TODO" "WAITING"))
+Skip current entry if the TODO keyword is TODO or WAITING.
+@item '(org-agenda-skip-entry-if 'todo 'done)
+Skip current entry if the TODO keyword marks a DONE state.
 @item '(org-agenda-skip-entry-if 'timestamp)
 @item '(org-agenda-skip-entry-if 'timestamp)
 Skip current entry if it has any timestamp, may also be deadline or scheduled.
 Skip current entry if it has any timestamp, may also be deadline or scheduled.
 @item '(org-agenda-skip-entry 'regexp "regular expression")
 @item '(org-agenda-skip-entry 'regexp "regular expression")

+ 6 - 0
lisp/ChangeLog

@@ -1,3 +1,9 @@
+2010-03-12  Carsten Dominik  <carsten.dominik@gmail.com>
+
+	* org-agenda.el (org-agenda-skip-if-todo): New function.
+	(org-agenda-skip-if): Add conditions for TODO keywords.
+	(org-agenda-skip-if): Document the new todo conditions.
+
 2010-03-11  Mikael Fornius  <mfo@abc.se>
 2010-03-11  Mikael Fornius  <mfo@abc.se>
 
 
 	* org.el (org-at-property-p): Check if we are inside a property
 	* org.el (org-at-property-p): Check if we are inside a property

+ 71 - 1
lisp/org-agenda.el

@@ -280,6 +280,24 @@ you can \"misuse\" it to also add other text to the header.  However,
 			     :tag "Condition type"
 			     :tag "Condition type"
 			     (list :tag "Regexp matches" :inline t (const :format "" 'regexp) (regexp))
 			     (list :tag "Regexp matches" :inline t (const :format "" 'regexp) (regexp))
 			     (list :tag "Regexp does not match" :inline t (const :format "" 'notregexp) (regexp))
 			     (list :tag "Regexp does not match" :inline t (const :format "" 'notregexp) (regexp))
+			     (list :tag "TODO state is" :inline t
+				   (const 'todo)
+				   (choice
+				    (const :tag "any not-done state" 'todo)
+				    (const :tag "any done state" 'done)
+				    (const :tag "any state" 'any)
+				    (list :tag "Keyword list"
+					  (const :format "" quote)
+					  (repeat (string :tag "Keyword")))))
+			     (list :tag "TODO state is not" :inline t
+				   (const 'nottodo)
+				   (choice
+				    (const :tag "any not-done state" 'todo)
+				    (const :tag "any done state" 'done)
+				    (const :tag "any state" 'any)
+				    (list :tag "Keyword list"
+					  (const :format "" quote)
+					  (repeat (string :tag "Keyword")))))
 			     (const :tag "scheduled" 'scheduled)
 			     (const :tag "scheduled" 'scheduled)
 			     (const :tag "not scheduled" 'notscheduled)
 			     (const :tag "not scheduled" 'notscheduled)
 			     (const :tag "deadline" 'deadline)
 			     (const :tag "deadline" 'deadline)
@@ -3793,10 +3811,26 @@ timestamp     Check if there is a timestamp (also deadline or scheduled)
 nottimestamp  Check if there is no timestamp (also deadline or scheduled)
 nottimestamp  Check if there is no timestamp (also deadline or scheduled)
 regexp        Check if regexp matches
 regexp        Check if regexp matches
 notregexp     Check if regexp does not match.
 notregexp     Check if regexp does not match.
+todo          Check if TODO keyword matches
+nottodo       Check if TODO keyword does not match
 
 
 The regexp is taken from the conditions list, it must come right after
 The regexp is taken from the conditions list, it must come right after
 the `regexp' or `notregexp' element.
 the `regexp' or `notregexp' element.
 
 
+`todo' and `nottodo' accept as an argument a list of todo
+keywords, which may include \"*\" to match any todo keyword.
+
+    (org-agenda-skip-entry-if 'todo '(\"TODO\" \"WAITING\"))
+
+would skip all entries with \"TODO\" or \"WAITING\" keywords.
+
+Instead of a list a keyword class may be given
+
+    (org-agenda-skip-entry-if 'nottodo 'done)
+
+would skip entries that haven't been marked with any of \"DONE\"
+keywords. Possible classes are: `todo', `done', `any'.
+
 If any of these conditions is met, this function returns the end point of
 If any of these conditions is met, this function returns the end point of
 the entity, causing the search to continue from there.  This is a function
 the entity, causing the search to continue from there.  This is a function
 that can be put into `org-agenda-skip-function' for the duration of a command."
 that can be put into `org-agenda-skip-function' for the duration of a command."
@@ -3826,9 +3860,45 @@ that can be put into `org-agenda-skip-function' for the duration of a command."
 	   (re-search-forward (nth 1 m) end t))
 	   (re-search-forward (nth 1 m) end t))
       (and (setq m (memq 'notregexp conditions))
       (and (setq m (memq 'notregexp conditions))
 	   (stringp (nth 1 m))
 	   (stringp (nth 1 m))
-	   (not (re-search-forward (nth 1 m) end t))))
+	   (not (re-search-forward (nth 1 m) end t)))
+      (and (or
+	    (setq m (memq 'todo conditions))
+	    (setq m (memq 'nottodo conditions)))
+	   (org-agenda-skip-if-todo m end)))
      end)))
      end)))
 
 
+(defun org-agenda-skip-if-todo (args end)
+  "Helper function for `org-agenda-skip-if', do not use it directly.
+ARGS is a list with first element either `todo' or `nottodo'.
+The remainder is either a list of TODO keywords, or a state symbol
+`todo' or `done' or `any'."
+  (let ((kw (car args))
+	(arg (cadr args))
+	todo-wds todo-re)
+    (setq todo-wds
+	  (org-uniquify
+	   (cond
+	    ((listp arg)   ;; list of keywords
+	     (if (member "*" arg)
+		 (mapcar 'substring-no-properties org-todo-keywords-1)
+	       arg))
+	    ((symbolp arg) ;; keyword class name
+	     (cond
+	      ((eq arg 'todo)
+	       (org-delete-all org-done-keywords
+			       (mapcar 'substring-no-properties
+				       org-todo-keywords-1)))
+	      ((eq arg 'done) org-done-keywords)
+	      ((eq arg 'any)
+	       (mapcar 'substring-no-properties org-todo-keywords-1)))))))
+    (setq todo-re
+	  (concat "^\\*+[ \t]+\\<\\("
+		  (mapconcat 'identity todo-wds  "\\|")
+		  "\\)\\>"))
+    (if (eq kw 'todo)
+	(re-search-forward todo-re end t)
+      (not (re-search-forward todo-re end t)))))
+
 ;;;###autoload
 ;;;###autoload
 (defun org-agenda-list-stuck-projects (&rest ignore)
 (defun org-agenda-list-stuck-projects (&rest ignore)
   "Create agenda view for projects that are stuck.
   "Create agenda view for projects that are stuck.