Merged from mwolson@gnu.org--2006 (patch 29-30)
[planner-el.git] / planner-deadline.el
blobf6dd89fa48b0f81d0c898c31b45e5bc5fc982226
1 ;;; planner-deadline.el --- Deadlines for planner.el
3 ;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
4 ;; Parts copyright (C) 2004, 2005 Dryice Dong Liu <dryice AT liu.com.cn>
6 ;; Author: Sandra Jean Chua (Sacha) <sacha AT free.net.ph>
7 ;; URL: http://www.plannerlove.com/
9 ;; This file is part of Planner. It is not part of GNU Emacs.
11 ;; Planner is free software; you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version.
16 ;; Planner is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with Planner; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02110-1301, USA.
26 ;;; Commentary:
28 ;; With the default setup, make your tasks of the form
30 ;; #A0 _ Some task {{Deadline: 2004.09.12}}
32 ;; Note: There must be at least one space after the colon.
34 ;; Run M-x planner-deadline-update to update the task descriptions.
36 (require 'planner)
38 ;;; Code:
40 ;;; USER VARIABLES -----------------------------------------------------------
42 (defgroup planner-deadline nil
43 "Deadline reports for planner.el."
44 :prefix "planner-deadline"
45 :group 'planner)
47 (defcustom planner-deadline-change-hook '(planner-deadline-update)
48 "Functions to run after `planner-deadline-change'.
49 Point will be on the same line as the task."
50 :type 'hook
51 :options '(planner-deadline-update)
52 :group 'planner-deadline)
54 (defcustom planner-deadline-regexp "\\({{Deadline:\\s-+\\([0-9]+\\.[0-9]+\\.[0-9]+\\)[^}\n]*}}\\)"
55 "Regular expression for deadline data.
56 The special deadline string should be regexp group 1. The
57 date (YYYY.MM.DD) should be regexp group 2."
58 :type 'regexp
59 :group 'planner-deadline)
61 (defun planner-deadline-get-deadline-from-string (string)
62 "Return the deadline in STRING."
63 (save-match-data
64 (if (string-match planner-deadline-regexp string)
65 (planner-match-string-no-properties 2 string)
66 nil)))
68 (defun planner-deadline-get-current-deadline ()
69 "Return the deadline of the current task."
70 (planner-deadline-get-deadline-from-string
71 (buffer-substring (planner-line-beginning-position)
72 (planner-line-end-position))))
74 (defun planner-deadline-days-left (deadline date)
75 "Return how many days are left for DEADLINE with effective DATE."
76 (let (diff
77 (date (if (listp date) (planner-task-date date) date)))
78 (if date
79 (setq diff
80 (- (calendar-absolute-from-gregorian
81 (planner-filename-to-calendar-date
82 deadline))
83 (calendar-absolute-from-gregorian
84 (planner-filename-to-calendar-date
85 date))))
86 (setq date
87 (if (not planner-use-day-pages)
88 (planner-date-to-filename (decode-time (current-time)))
89 (if (string-match planner-date-regexp (planner-page-name))
90 (planner-page-name)
91 (planner-today)))))
92 (setq diff
93 (- (calendar-absolute-from-gregorian
94 (planner-filename-to-calendar-date
95 deadline))
96 (calendar-absolute-from-gregorian
97 (planner-filename-to-calendar-date
98 date))))
99 diff))
101 (defun planner-deadline-calculate-string (deadline &optional date)
102 "Return a deadline string for DEADLINE and effective DATE."
103 (let ((diff (planner-deadline-days-left deadline date)))
104 (concat "{{Deadline: "
105 deadline
106 " - "
107 (cond
108 ((< diff 0) (format "%d %s *OVERDUE*"
109 (- diff)
110 (if (= diff -1) "day"
111 "days")))
112 ((= diff 0) "*TODAY*")
113 (t (format "%d %s" diff
114 (if (= diff 1)
115 "day"
116 "days"))))
117 "}}")))
119 ;;;###autoload
120 (defun planner-deadline-update ()
121 "Replace the text for all tasks with deadlines.
122 By default, deadlines are of the form {{Deadline: yyyy.mm.dd}}.
123 See `planner-deadline-regexp' for details."
124 (interactive)
125 (with-planner-update-setup
126 (goto-char (point-min))
127 (while (re-search-forward planner-deadline-regexp nil t)
128 (let* ((deadline (match-string 2))
129 (task-info (save-match-data (planner-current-task-info)))
130 (status (planner-task-status task-info))
131 (end (match-end 0))
132 new)
133 (save-match-data
134 (if task-info
135 (unless (or (equal status "X")
136 (equal status "C"))
137 (setq new (planner-deadline-calculate-string
138 deadline task-info)))
139 (setq new (planner-deadline-calculate-string deadline nil))))
140 (when new
141 (if task-info
142 (when (string-match planner-deadline-regexp
143 (planner-task-description task-info))
144 (planner-edit-task-description
145 (replace-match new t t (planner-task-description task-info))))
146 (replace-match new t t)
147 (when (planner-current-note-info) (planner-update-note))))
148 (goto-char (1+ end))))))
150 ;;;###autoload
151 (defun planner-deadline-change (date)
152 "Change the deadline of current task to DATE.
153 If DATE is nil, prompt for it."
154 (interactive (list (planner-read-date nil t)))
155 (let* ((info (planner-current-task-info))
156 (description (planner-task-description info)))
157 (when date
158 (when (string-match (concat "\\s-*" planner-deadline-regexp)
159 description)
160 (setq description (replace-match "" t t description)))
161 (planner-edit-task-description (concat description
162 " {{Deadline: "
163 date
164 "}}"))
165 (run-hooks 'planner-deadline-change-hook))))
167 ;;;###autoload
168 (defalias 'planner-deadline-add 'planner-deadline-change)
170 ;;;###autoload
171 (defun planner-deadline-remove ()
172 "Remove the deadline of the current task."
173 (interactive)
174 (let* ((info (planner-current-task-info))
175 (description (planner-task-description info)))
176 (when (string-match (concat "\\s-*" planner-deadline-regexp)
177 description)
178 (setq description (replace-match "" t t description))
179 (planner-edit-task-description description))))
181 ;; Insinuate planner-deadline-update into planner-goto-hook
182 (add-to-list 'planner-goto-hook 'planner-deadline-update)
184 (provide 'planner-deadline)
186 ;;; planner-deadline.el ends here