mirror/org-mode
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2025-01-30 20:41:41 +00:00
Code

Implement sorting by TODO keyword sequence position.

Browse Source
This commit is contained in:
Carsten Dominik 2008-09-18 13:45:49 +02:00
parent 152092ce2b
commit 7b0f0c497c
3 changed files with 60 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
ORGWEBPAGE/Changes.org
View File

@ -194,6 +194,16 @@
This was a request by Chris Randle.
*** Agenda views can sort entries by TODO state
You can now define a sorting strategy for agenda entries that
does look at the TODO state of the entries. Sorting by TODO
entry does first separate the non-done from the done states.
Within each class, the entries are sorted not alphabetically,
but in definition order. So if you have a sequence of TODO
entries defined, the entries will be sorted according to the
position of the keyword in this sequence.
* Version 6.06
** Overview

9
lisp/ChangeLog
View File

@ -1,7 +1,14 @@
2008-09-18 Carsten Dominik <dominik@science.uva.nl>
* org-agenda.el (org-sorting-choice)
(org-agenda-sorting-strategy, org-agenda-get-todos)
(org-agenda-get-timestamps, org-agenda-get-deadlines)
(org-agenda-get-scheduled, org-agenda-get-blocks)
(org-entries-lessp): Implement sorting by TODO state.
(org-cmp-todo-state): New defsubst.
* org-colview.el (org-colview-construct-allowed-dates): New
function.
function.
(org-columns-next-allowed-value): Use
`org-colview-construct-allowed-dates'.

55
lisp/org-agenda.el
View File

@ -149,6 +149,7 @@ you can \"misuse\" it to also add other text to the header. However,
(const category-keep) (const category-up) (const category-down)
(const tag-down) (const tag-up)
(const priority-up) (const priority-down)
(const todo-state-up) (const todo-state-down)
(const effort-up) (const effort-down))
"Sorting choices.")
@ -712,7 +713,7 @@ a grid line."
(defcustom org-agenda-sorting-strategy
'((agenda time-up category-keep priority-down)
(todo category-keep priority-down)
(todo todo-state-down category-keep priority-down)
(tags category-keep priority-down)
(search category-keep))
"Sorting structure for the agenda items of a single day.
@ -730,6 +731,8 @@ tag-up Sort alphabetically by last tag, A-Z.
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.
effort-up Sort numerically by estimated effort, high effort last.
effort-down Sort numerically by estimated effort, high effort first.
@ -3135,7 +3138,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)
@ -3160,11 +3163,12 @@ 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))
@ -3206,7 +3210,8 @@ the documentation of `org-diary'."
"\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
"\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
marker hdmarker deadlinep scheduledp clockp closedp inactivep
donep tmp priority category ee txt timestr tags b0 b3 e3 head)
donep tmp priority category ee txt timestr tags b0 b3 e3 head
todo-state)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(setq b0 (match-beginning 0)
@ -3236,7 +3241,8 @@ the documentation of `org-diary'."
clockp (and org-agenda-include-inactive-timestamps
(or (string-match org-clock-string tmp)
(string-match "]-+\\'" tmp)))
donep (org-entry-is-done-p))
todo-state (org-get-todo-state)
donep (member todo-state org-done-keywords))
(if (or scheduledp deadlinep closedp clockp)
(throw :skip t))
(if (string-match ">" timestr)
@ -3261,6 +3267,7 @@ the documentation of `org-diary'."
'org-marker marker 'org-hd-marker hdmarker)
(org-add-props txt nil 'priority priority
'org-category category 'date date
'todo-state todo-state
'type "timestamp")
(push txt ee))
(outline-next-heading)))
@ -3382,7 +3389,7 @@ the documentation of `org-diary'."
(todayp (org-agenda-todayp 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
@ -3404,6 +3411,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))
@ -3413,7 +3421,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)) " "))
@ -3440,6 +3448,7 @@ the documentation of `org-diary'."
'priority (+ (- diff)
(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)
@ -3471,7 +3480,7 @@ FRACTION is what fraction of the head-warning time has passed."
(todayp (org-agenda-todayp 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 face timestr s)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
@ -3491,6 +3500,7 @@ FRACTION is what fraction of the head-warning time has passed."
(= 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))
@ -3499,7 +3509,7 @@ FRACTION is what fraction of the head-warning time has passed."
(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)) " "))
@ -3530,7 +3540,8 @@ FRACTION is what fraction of the head-warning time has passed."
'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)))
@ -3547,7 +3558,7 @@ FRACTION is what fraction of the head-warning time has passed."
(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)
@ -3565,6 +3576,7 @@ FRACTION is what fraction of the head-warning time has passed."
(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))
@ -3584,6 +3596,7 @@ FRACTION is what fraction of the head-warning time has passed."
(org-add-props txt props
'org-marker marker 'org-hd-marker hdmarker
'type "block" 'date date
'todo-state todo-state
'priority (org-get-priority txt) 'org-category category)
(push txt ee)))
(goto-char pos)))
@ -3899,6 +3912,20 @@ 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) ""))
(la (- (length (member ta org-todo-keywords-for-agenda))))
(lb (- (length (member tb org-todo-keywords-for-agenda))))
(donepa (member ta org-done-keywords-for-agenda))
(donepb (member tb org-done-keywords-for-agenda)))
(cond ((and donepa (not donepb)) -1)
((and (not donepa) donepb) +1)
((< la lb) -1)
((< lb la) +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))))
@ -3932,7 +3959,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))))))