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