emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: Christian Egli <christian.egli@novell.com>
To: emacs-orgmode@gnu.org
Subject: Re: Getting org-agenda-sorting-strategy to work
Date: Wed, 09 Jan 2008 23:40:22 +0100	[thread overview]
Message-ID: <87abne7hd5.fsf@novell.com> (raw)
In-Reply-To: 52D89C75FEE9444E8D9C016E3730098306CE8F@chsa1036.share.beluni.net

[-- Attachment #1: Type: text/plain, Size: 448 bytes --]

"Egli Christian (KIRO 41)" <christian.egli@credit-suisse.com> writes:

> I have a patch that implements this for v5.17. Carsten is willing to
> accept it but I'm waiting on the layers to sign the copyright
> disclaimer. 

Here's the patch against 5.18a. It implements sorting by todo state and
todo keyword in the agenda. See the customize interface for
org-agenda-sorting-strategy to find out how to enable it. Should be
fairly self-explanatory.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch to enable sorting by todo keyword --]
[-- Type: text/x-diff, Size: 8868 bytes --]

# HG changeset patch
# User Christian Egli <christian.egli@alumni.ethz.ch>
# Date 1199917882 -3600
# Node ID 48c4b74b3c08ae4e62a80422511be6ceab791582
# Parent  3285ee44e04c63c40602f7680c340b5dd0fe51ed
# Parent  4425bb2aa82bcbbac538460a39dec07cd340e975
implement sorting by todo state in the agenda sorting strategy

diff -r 3285ee44e04c -r 48c4b74b3c08 org.el
--- a/org.el	Wed Jan 09 23:18:00 2008 +0100
+++ b/org.el	Wed Jan 09 23:31:22 2008 +0100
@@ -2679,7 +2679,8 @@ a grid line."
     (const time-up) (const time-down)
     (const category-keep) (const category-up) (const category-down)
     (const tag-down) (const tag-up)
-    (const priority-up) (const priority-down))
+    (const priority-up) (const priority-down)
+    (const todo-state-up) (const todo-state-down))
   "Sorting choices.")
 
 (defcustom org-agenda-sorting-strategy
@@ -2701,6 +2702,8 @@ tag-down        Sort alphabetically by l
 tag-down        Sort alphabetically by last tag, Z-A.
 priority-up     Sort numerically by priority, high priority last.
 priority-down   Sort numerically by priority, high priority first.
+todo-state-up   Sort by todo state, tasks that are done last.
+todo-state-down Sort by todo state, tasks that are done first.
 
 The different possibilities will be tried in sequence, and testing stops
 if one comparison returns a \"not-equal\".  For example, the default
@@ -20867,7 +20870,7 @@ the documentation of `org-diary'."
 				     "\\)\\>"))
 			   org-not-done-regexp)
 			 "[^\n\r]*\\)"))
-	 marker priority category tags
+	 marker priority category tags todo-state
 	 ee txt beg end)
     (goto-char (point-min))
     (while (re-search-forward regexp nil t)
@@ -20892,11 +20895,13 @@ the documentation of `org-diary'."
 	      category (org-get-category)
 	      tags (org-get-tags-at (point))
 	      txt (org-format-agenda-item "" (match-string 1) category tags)
-	      priority (1+ (org-get-priority txt)))
+	      priority (1+ (org-get-priority txt))
+	      todo-state (org-get-todo-state))
 	(org-add-props txt props
 	  'org-marker marker 'org-hd-marker marker
 	  'priority priority 'org-category category
-	  'type "todo")
+	  'type "todo"
+	  'todo-state todo-state)
 	(push txt ee)
 	(if org-agenda-todo-list-sublevels
 	    (goto-char (match-end 1))
@@ -20935,7 +20940,7 @@ the documentation of `org-diary'."
 	     0 11))
 	   "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
 	   "\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
-	 marker hdmarker deadlinep scheduledp donep tmp priority category
+	 marker hdmarker deadlinep scheduledp todo-state donep tmp priority category
 	 ee txt timestr tags b0 b3 e3 head)
     (goto-char (point-min))
     (while (re-search-forward regexp nil t)
@@ -20958,7 +20963,8 @@ the documentation of `org-diary'."
 	      timestr (if b3 "" (buffer-substring b0 (point-at-eol)))
 	      deadlinep (string-match org-deadline-regexp tmp)
 	      scheduledp (string-match org-scheduled-regexp tmp)
-	      donep (org-entry-is-done-p))
+	      todo-state (org-get-todo-state)
+	      donep (member todo-state org-not-done-keywords))
 	(if (or scheduledp deadlinep) (throw :skip t))
 	(if (string-match ">" timestr)
 	    ;; substring should only run to end of time stamp
@@ -20980,7 +20986,9 @@ the documentation of `org-diary'."
 	  (org-add-props txt props
 	    'org-marker marker 'org-hd-marker hdmarker)
 	  (org-add-props txt nil 'priority priority
-			 'org-category category 'date date
+			 'org-category category
+			 'todo-state todo-state
+			 'date date
 			 'type "timestamp")
 	  (push txt ee))
 	(outline-next-heading)))
@@ -21094,7 +21102,7 @@ the documentation of `org-diary'."
 	 (todayp (equal date (calendar-current-date))) ; DATE bound by calendar
 	 (d1 (calendar-absolute-from-gregorian date))  ; DATE bound by calendar
 	 d2 diff dfrac wdays pos pos1 category tags
-	 ee txt head face s upcomingp donep timestr)
+	 ee txt head face s todo-state upcomingp donep timestr)
     (goto-char (point-min))
     (while (re-search-forward regexp nil t)
       (catch :skip
@@ -21114,6 +21122,7 @@ the documentation of `org-diary'."
 		(= diff 0))
 	    (save-excursion
 	      (setq category (org-get-category))
+	      (setq todo-state (org-get-todo-state))
 	      (if (re-search-backward "^\\*+[ \t]+" nil t)
 		  (progn
 		    (goto-char (match-end 0))
@@ -21123,7 +21132,7 @@ the documentation of `org-diary'."
 				(point)
 				(progn (skip-chars-forward "^\r\n")
 				       (point))))
-		    (setq donep (string-match org-looking-at-done-regexp head))
+		    (setq donep (member todo-state org-done-keywords))
 		    (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
 			(setq timestr
 			      (concat (substring s (match-beginning 1)) " "))
@@ -21147,6 +21156,7 @@ the documentation of `org-diary'."
 		  'priority (+ (if upcomingp (floor (* dfrac 10.)) 100)
 			       (org-get-priority txt))
 		  'org-category category
+		  'todo-state todo-state
 		  'type (if upcomingp "upcoming-deadline" "deadline")
 		  'date (if upcomingp date d2)
 		  'face (if donep 'org-done face)
@@ -21176,7 +21186,7 @@ FRACTION is what fraction of the head-wa
 	 (todayp (equal date (calendar-current-date))) ; DATE bound by calendar
 	 (d1 (calendar-absolute-from-gregorian date))  ; DATE bound by calendar
 	 d2 diff pos pos1 category tags
-	 ee txt head pastschedp donep face timestr s)
+	 ee txt head pastschedp todo-state donep face timestr s)
     (goto-char (point-min))
     (while (re-search-forward regexp nil t)
       (catch :skip
@@ -21193,6 +21203,7 @@ FRACTION is what fraction of the head-wa
 		(= diff 0))
 	    (save-excursion
 	      (setq category (org-get-category))
+	      (setq todo-state (org-get-todo-state))
 	      (if (re-search-backward "^\\*+[ \t]+" nil t)
 		  (progn
 		    (goto-char (match-end 0))
@@ -21201,7 +21212,7 @@ FRACTION is what fraction of the head-wa
 		    (setq head (buffer-substring-no-properties
 				(point)
 				(progn (skip-chars-forward "^\r\n") (point))))
-		    (setq donep (string-match org-looking-at-done-regexp head))
+		    (setq donep (member todo-state org-done-keywords))
 		    (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
 			(setq timestr
 			      (concat (substring s (match-beginning 1)) " "))
@@ -21229,7 +21240,8 @@ FRACTION is what fraction of the head-wa
 		  'type (if pastschedp "past-scheduled" "scheduled")
 		  'date (if pastschedp d2 date)
 		  'priority (+ 94 (- 5 diff) (org-get-priority txt))
-		  'org-category category)
+		  'org-category category
+		  'todo-state todo-state)
 		(push txt ee))))))
     (nreverse ee)))
 
@@ -21245,7 +21257,7 @@ FRACTION is what fraction of the head-wa
 			      (abbreviate-file-name buffer-file-name))))
 	 (regexp org-tr-regexp)
 	 (d0 (calendar-absolute-from-gregorian date))
-	 marker hdmarker ee txt d1 d2 s1 s2 timestr category tags pos
+	 marker hdmarker ee txt d1 d2 s1 s2 timestr category todo-state tags pos
 	 donep head)
     (goto-char (point-min))
     (while (re-search-forward regexp nil t)
@@ -21263,6 +21275,7 @@ FRACTION is what fraction of the head-wa
 	    (save-excursion
 	      (setq marker (org-agenda-new-marker (point)))
 	      (setq category (org-get-category))
+	      (setq todo-state (org-get-todo-state))
 	      (if (re-search-backward "^\\*+ " nil t)
 		  (progn
 		    (goto-char (match-beginning 0))
@@ -21282,7 +21295,9 @@ FRACTION is what fraction of the head-wa
 	      (org-add-props txt props
 		'org-marker marker 'org-hd-marker hdmarker
 		'type "block" 'date date
-		'priority (org-get-priority txt) 'org-category category)
+		'priority (org-get-priority txt) 
+		'org-category category
+		'todo-state todo-state)
 	      (push txt ee)))
 	(goto-char pos)))
     ;; Sort the entries by expiration date.
@@ -21583,6 +21598,18 @@ HH:MM."
 	  ((string-lessp cb ca) +1)
 	  (t nil))))
 
+(defsubst org-cmp-todo-state (a b)
+  "Compare the todo states of strings A and B."
+  (let* ((ta (or (get-text-property 1 'todo-state a) ""))
+	 (tb (or (get-text-property 1 'todo-state b) ""))
+	 (donepa (member ta org-done-keywords)) 
+	 (donepb (member tb org-done-keywords)))
+    (cond ((and donepa (not donepb)) -1)
+	  ((and (not donepa) donepb) +1)
+	  ((string-lessp ta tb) -1)
+	  ((string-lessp tb ta) +1)
+	  (t nil))))
+
 (defsubst org-cmp-tag (a b)
   "Compare the string values of categories of strings A and B."
   (let ((ta (car (last (get-text-property 1 'tags a))))
@@ -21614,7 +21641,9 @@ HH:MM."
 	 (category-down (if category-up (- category-up) nil))
 	 (category-keep (if category-up +1 nil))
 	 (tag-up (org-cmp-tag a b))
-	 (tag-down (if tag-up (- tag-up) nil)))
+	 (tag-down (if tag-up (- tag-up) nil))
+	 (todo-state-up (org-cmp-todo-state a b))
+	 (todo-state-down (if todo-state-up (- todo-state-up) nil)))
     (cdr (assoc
 	  (eval (cons 'or org-agenda-sorting-strategy-selected))
 	  '((-1 . t) (1 . nil) (nil . nil))))))

[-- Attachment #3: Type: text/plain, Size: 197 bytes --]


As I said unfortunatelly I'm still waiting on the laywers for the
disclaimer, so this code cannot go into Carstens master copy. But you
can play with it anyway and report any feedback.

Christian

[-- Attachment #4: Type: text/plain, Size: 204 bytes --]

_______________________________________________
Emacs-orgmode mailing list
Remember: use `Reply All' to send replies to the list.
Emacs-orgmode@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-orgmode

      reply	other threads:[~2008-01-09 22:40 UTC|newest]

Thread overview: 10+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2008-01-06 21:30 Getting org-agenda-sorting-strategy to work MarkS
2008-01-07  1:51 ` Bastien
2008-01-07  5:49   ` MarkS
2008-01-07  6:02     ` Bastien
2008-01-07  6:12       ` MarkS
2008-01-07  6:45         ` Bastien
2008-01-07 14:42           ` MarkS
2008-01-08 13:42             ` Bastien
2008-01-08 13:45               ` Egli Christian (KIRO 41)
2008-01-09 22:40                 ` Christian Egli [this message]

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=87abne7hd5.fsf@novell.com \
    --to=christian.egli@novell.com \
    --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).