[Orgmode] Re: Getting org-agenda-sorting-strategy to work

[Christian Egli]

"Egli Christian (KIRO 41)" <address@hidden> 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.

# HG changeset patch
# User Christian Egli <address@hidden>
# 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))))))

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