[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/org/org-agenda.el,v
|
From: |
Carsten Dominik |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/org/org-agenda.el,v |
|
Date: |
Sun, 12 Oct 2008 06:12:49 +0000 |
CVSROOT: /sources/emacs
Module name: emacs
Changes by: Carsten Dominik <cdominik> 08/10/12 06:12:47
Index: org-agenda.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/org/org-agenda.el,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -b -r1.8 -r1.9
--- org-agenda.el 25 Jul 2008 23:02:14 -0000 1.8
+++ org-agenda.el 12 Oct 2008 06:12:44 -0000 1.9
@@ -6,7 +6,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 6.06b
+;; Version: 6.09a
;;
;; This file is part of GNU Emacs.
;;
@@ -149,6 +149,7 @@
(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.")
@@ -730,6 +731,8 @@
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.
@@ -938,8 +941,11 @@
(defcustom org-agenda-fontify-priorities t
"Non-nil means, highlight low and high priorities in agenda.
When t, the highest priority entries are bold, lowest priority italic.
-This may also be an association list of priority faces. The face may be
-a names face, or a list like `(:background \"Red\")'."
+This may also be an association list of priority faces, whose
+keys are the character values of `org-highest-priority',
+`org-default-priority', and `org-lowest-priority' (the default values
+are ?A, ?B, and ?C, respectively). The face may be a names face,
+or a list like `(:background \"Red\")'."
:group 'org-agenda-line-format
:type '(choice
(const :tag "Never" nil)
@@ -1126,6 +1132,7 @@
(org-defkey org-agenda-mode-map "T" 'org-agenda-show-tags)
(org-defkey org-agenda-mode-map "n" 'next-line)
(org-defkey org-agenda-mode-map "p" 'previous-line)
+(org-defkey org-agenda-mode-map "\C-c\C-a" 'org-attach)
(org-defkey org-agenda-mode-map "\C-c\C-n" 'org-agenda-next-date-line)
(org-defkey org-agenda-mode-map "\C-c\C-p" 'org-agenda-previous-date-line)
(org-defkey org-agenda-mode-map "," 'org-agenda-priority)
@@ -1159,6 +1166,7 @@
(org-defkey org-agenda-mode-map "]" 'org-agenda-manipulate-query-subtract)
(org-defkey org-agenda-mode-map "{" 'org-agenda-manipulate-query-add-re)
(org-defkey org-agenda-mode-map "}" 'org-agenda-manipulate-query-subtract-re)
+(org-defkey org-agenda-mode-map "/" 'org-agenda-filter-by-tag)
(defvar org-agenda-keymap (copy-keymap org-agenda-mode-map)
"Local keymap for agenda entries from Org-mode.")
@@ -1497,7 +1505,7 @@
-------------------------------- > Remove restriction
a Agenda for current week or day e Export agenda views
t List of all TODO entries T Entries with special TODO kwd
-m Match a TAGS query M Like m, but only TODO entries
+m Match a TAGS/PROP/TODO query M Like m, but only TODO entries
L Timeline for current buffer # List stuck projects (!=configure)
s Search for keywords C Configure custom agenda commands
/ Multi-occur
@@ -1879,6 +1887,7 @@
(t
(let ((bs (buffer-string)))
(find-file file)
+ (erase-buffer)
(insert bs)
(save-buffer 0)
(kill-buffer (current-buffer))
@@ -3133,7 +3142,7 @@
"\\)\\>"))
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)
@@ -3158,11 +3167,12 @@
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))
@@ -3204,7 +3214,8 @@
"\\|\\(<[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)
@@ -3234,7 +3245,8 @@
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)
@@ -3259,6 +3271,7 @@
'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)))
@@ -3325,7 +3338,7 @@
(list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
1 11))))
marker hdmarker priority category tags closedp
- ee txt timestr rest)
+ ee txt timestr rest clocked)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
@@ -3341,10 +3354,11 @@
(setq rest (substring timestr (match-end 0))
timestr (substring timestr 0 (match-end 0)))
(if (and (not closedp)
- (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\]" rest))
- (setq timestr (concat (substring timestr 0 -1)
- "-" (match-string 1 rest) "]"))))
-
+ (string-match
"\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)" rest))
+ (progn (setq timestr (concat (substring timestr 0 -1)
+ "-" (match-string 1 rest) "]"))
+ (setq clocked (match-string 2 rest)))
+ (setq clocked "-")))
(save-excursion
(if (re-search-backward "^\\*+ " nil t)
(progn
@@ -3353,7 +3367,8 @@
tags (org-get-tags-at))
(looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
(setq txt (org-format-agenda-item
- (if closedp "Closed: " "Clocked: ")
+ (if closedp "Closed: "
+ (concat "Clocked: (" clocked ")"))
(match-string 1) category tags timestr)))
(setq txt org-agenda-no-heading-message))
(setq priority 100000)
@@ -3377,10 +3392,10 @@
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name))))
(regexp org-deadline-time-regexp)
- (todayp (equal date (calendar-current-date))) ; DATE bound by calendar
+ (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
@@ -3402,6 +3417,7 @@
(= 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))
@@ -3411,7 +3427,7 @@
(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)) " "))
@@ -3427,7 +3443,8 @@
(funcall (nth 1
org-agenda-deadline-leaders) diff date)
(format (nth 1 org-agenda-deadline-leaders)
diff)))
- head category tags timestr))))
+ head category tags
+ (if (not (= diff 0)) nil timestr)))))
(setq txt org-agenda-no-heading-message))
(when txt
(setq face (org-agenda-deadline-face dfrac wdays))
@@ -3437,6 +3454,7 @@
'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)
@@ -3465,10 +3483,10 @@
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name))))
(regexp org-scheduled-time-regexp)
- (todayp (equal date (calendar-current-date))) ; DATE bound by calendar
+ (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)
+ d2 diff pos pos1 category tags donep
+ ee txt head pastschedp todo-state face timestr s)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
@@ -3488,6 +3506,7 @@
(= 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))
@@ -3496,7 +3515,7 @@
(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)) " "))
@@ -3510,12 +3529,15 @@
(car org-agenda-scheduled-leaders)
(format (nth 1 org-agenda-scheduled-leaders)
(- 1 diff)))
- head category tags timestr))))
+ head category tags
+ (if (not (= diff 0)) nil timestr)))))
(setq txt org-agenda-no-heading-message))
(when txt
- (setq face (if pastschedp
- 'org-scheduled-previously
- 'org-scheduled-today))
+ (setq face
+ (cond
+ (pastschedp 'org-scheduled-previously)
+ (todayp 'org-scheduled-today)
+ (t 'org-scheduled)))
(org-add-props txt props
'undone-face face
'face (if donep 'org-done face)
@@ -3524,7 +3546,8 @@
'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)))
@@ -3541,7 +3564,7 @@
(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)
@@ -3559,6 +3582,7 @@
(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))
@@ -3578,6 +3602,7 @@
(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)))
@@ -3839,15 +3864,16 @@
(mapconcat 'identity (sort list 'org-entries-lessp) "\n")))
(defun org-agenda-highlight-todo (x)
- (let (re pl)
+ (let ((org-done-keywords org-done-keywords-for-agenda)
+ re pl)
(if (eq x 'line)
(save-excursion
(beginning-of-line 1)
(setq re (get-text-property (point) 'org-todo-regexp))
(goto-char (+ (point) (or (get-text-property (point) 'prefix-length)
0)))
- (when (looking-at (concat "[ \t]*\\.*" re " +"))
+ (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +"))
(add-text-properties (match-beginning 0) (match-end 0)
- (list 'face (org-get-todo-face 0)))
+ (list 'face (org-get-todo-face 1)))
(let ((s (buffer-substring (match-beginning 1) (match-end 1))))
(delete-region (match-beginning 1) (1- (match-end 0)))
(goto-char (match-beginning 1))
@@ -3893,6 +3919,20 @@
((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))))
@@ -3926,7 +3966,9 @@
(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))))))
@@ -4073,6 +4115,63 @@
(goto-line line)
(recenter window-line)))
+(defvar org-global-tags-completion-table nil)
+(defun org-agenda-filter-by-tag (strip &optional char)
+ "Keep only those lines in the agenda buffer that have a specific tag.
+The tag is selected with its fast selection letter, as configured.
+With prefix argument STRIP, remove all lines that do have the tag."
+ (interactive "P")
+ (let (char a tag tags (inhibit-read-only t))
+ (message "Select tag [%s] or no tag [ ], [TAB] to complete, [/] to
restore: "
+ (mapconcat
+ (lambda (x) (if (cdr x) (char-to-string (cdr x)) ""))
+ org-tag-alist-for-agenda ""))
+ (setq char (read-char))
+ (when (equal char ?\t)
+ (unless (local-variable-p 'org-global-tags-completion-table)
+ (org-set-local 'org-global-tags-completion-table
+ (org-global-tags-completion-table)))
+ (let ((completion-ignore-case t))
+ (setq tag (completing-read
+ "Tag: " org-global-tags-completion-table))))
+ (cond
+ ((equal char ?/) (org-agenda-filter-by-tag-show-all))
+ ((or (equal char ?\ )
+ (setq a (rassoc char org-tag-alist-for-agenda))
+ (and tag (setq a (cons tag nil))))
+ (org-agenda-filter-by-tag-show-all)
+ (setq tag (car a))
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (get-text-property (point) 'org-marker)
+ (progn
+ (setq tags (get-text-property (point) 'tags))
+ (if (not tag)
+ (if (or (and strip (not tags))
+ (and (not strip) tags))
+ (org-agenda-filter-by-tag-hide-line))
+ (if (or (and (member tag tags) strip)
+ (and (not (member tag tags)) (not strip)))
+ (org-agenda-filter-by-tag-hide-line)))
+ (beginning-of-line 2))
+ (beginning-of-line 2)))))
+ (t (error "Invalid tag selection character %c" char)))))
+
+(defvar org-agenda-filter-overlays nil)
+
+(defun org-agenda-filter-by-tag-hide-line ()
+ (let (ov)
+ (setq ov (org-make-overlay (max (point-min) (1- (point-at-bol)))
+ (point-at-eol)))
+ (org-overlay-put ov 'invisible t)
+ (org-overlay-put ov 'type 'tags-filter)
+ (push ov org-agenda-filter-overlays)))
+
+(defun org-agenda-filter-by-tag-show-all ()
+ (mapc 'org-delete-overlay org-agenda-filter-overlays)
+ (setq org-agenda-filter-overlays nil))
+
(defun org-agenda-manipulate-query-add ()
"Manipulate the query by adding a search term with positive selection.
Positive selection means, the term must be matched for selection of an entry."
@@ -4768,8 +4867,12 @@
(if line (point-at-eol) nil) t)
(add-text-properties
(match-beginning 2) (match-end 2)
- (list 'face (delq nil (list 'org-tag (get-text-property
- (match-beginning 2) 'face)))))
+ (list 'face (delq nil (adjoin 'org-tag
+ (let ((prop (get-text-property
+ (match-beginning 2)
'face)))
+ (if (listp prop)
+ prop
+ (list prop)))))))
(setq l (- (match-end 2) (match-beginning 2))
c (if (< org-agenda-tags-column 0)
(- (abs org-agenda-tags-column) l)
@@ -5265,7 +5368,7 @@
(org-deadline-warning-days 0)
(today (org-date-to-gregorian
(time-to-days (current-time))))
- (files (org-agenda-files)) entries file)
+ (files (org-agenda-files 'unrestricted)) entries file)
;; Get all entries which may contain an appt
(while (setq file (pop files))
(setq entries
@@ -5276,7 +5379,7 @@
;; Map thru entries and find if we should filter them out
(mapc
(lambda(x)
- (let* ((evt (org-trim (get-text-property 1 'txt x)))
+ (let* ((evt (org-trim (or (get-text-property 1 'txt x) "")))
(cat (get-text-property 1 'org-category x))
(tod (get-text-property 1 'time-of-day x))
(ok (or (null filter)
@@ -5289,9 +5392,9 @@
;; FIXME: Shall we remove text-properties for the appt text?
;; (setq evt (set-text-properties 0 (length evt) nil evt))
(when (and ok tod)
- (setq tod (number-to-string tod)
+ (setq tod (concat "00" (number-to-string tod))
tod (when (string-match
- "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)" tod)
+ "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod)
(concat (match-string 1 tod) ":"
(match-string 2 tod))))
(appt-add tod evt)
@@ -5301,10 +5404,20 @@
(message "No event to add")
(message "Added %d event%s for today" cnt (if (> cnt 1) "s" "")))))
+(defun org-agenda-todayp (date)
+ "Does DATE mean today, when considering `org-extend-today-until'?"
+ (let (today h)
+ (if (listp date) (setq date (calendar-absolute-from-gregorian date)))
+ (setq today (calendar-absolute-from-gregorian (calendar-current-date)))
+ (setq h (nth 2 (decode-time (current-time))))
+ (or (and (>= h org-extend-today-until)
+ (= date today))
+ (and (< h org-extend-today-until)
+ (= date (1- today))))))
+
(provide 'org-agenda)
;; arch-tag: 77f7565d-7c4b-44af-a2df-9f6f7070cff1
;;; org-agenda.el ends here
-
- [Emacs-diffs] Changes to emacs/lisp/org/org-agenda.el,v,
Carsten Dominik <=