From mboxrd@z Thu Jan 1 00:00:00 1970 From: Christian Egli Subject: Re: Getting org-agenda-sorting-strategy to work Date: Wed, 09 Jan 2008 23:40:22 +0100 Message-ID: <87abne7hd5.fsf@novell.com> References: <874pdqh07g.fsf@bzg.ath.cx> <87ir268971.fsf@bzg.ath.cx> <87ejcu876v.fsf@bzg.ath.cx> <87lk70h1sk.fsf@bzg.ath.cx> <52D89C75FEE9444E8D9C016E3730098306CE8F@chsa1036.share.beluni.net> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1JCjbB-0000Kn-LP for emacs-orgmode@gnu.org; Wed, 09 Jan 2008 17:40:37 -0500 Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1JCjbA-0000Ka-4b for emacs-orgmode@gnu.org; Wed, 09 Jan 2008 17:40:37 -0500 Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1JCjbA-0000KX-0J for emacs-orgmode@gnu.org; Wed, 09 Jan 2008 17:40:36 -0500 Received: from main.gmane.org ([80.91.229.2] helo=ciao.gmane.org) by monty-python.gnu.org with esmtps (TLS-1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.60) (envelope-from ) id 1JCjb9-0004jG-9U for emacs-orgmode@gnu.org; Wed, 09 Jan 2008 17:40:35 -0500 Received: from list by ciao.gmane.org with local (Exim 4.43) id 1JCjb2-0001ST-T2 for emacs-orgmode@gnu.org; Wed, 09 Jan 2008 22:40:28 +0000 Received: from 77-56-52-52.dclient.hispeed.ch ([77.56.52.52]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Wed, 09 Jan 2008 22:40:28 +0000 Received: from christian.egli by 77-56-52-52.dclient.hispeed.ch with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Wed, 09 Jan 2008 22:40:28 +0000 List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: emacs-orgmode@gnu.org --=-=-= "Egli Christian (KIRO 41)" 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. --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=sortingByTodoState.patch Content-Description: patch to enable sorting by todo keyword # 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)))))) --=-=-= 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 --=-=-= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ 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 --=-=-=--