1 ;;; planner-trunk.el --- Trunk tasks for the Emacs planner
4 ;; Copyright (C) 2005, 2008 Dryice Dong Liu . All rights reserved.
5 ;; Parts copyright (C) 2005, 2008 Keith Amidon
6 ;; Parts copyright (C) 2005, 2008 Free Software Foundation, Inc.
7 ;; Parts copyright (C) 2006, 2007 Software Freedom Law Center
9 ;; Keywords: emacs planner trunk group tasks
10 ;; Authors: Dryice Liu <dryice AT liu DOT com DOT cn>
11 ;; Keith Amidon <camalot AT picnicpark dot org>
12 ;; Description: trunk(group) tasks for the Emacs planner
14 ;; This file is part of Planner. It is not part of GNU Emacs.
16 ;; Planner is free software; you can redistribute it and/or modify it
17 ;; under the terms of the GNU General Public License as published by
18 ;; the Free Software Foundation; either version 3, or (at your option)
21 ;; Planner is distributed in the hope that it will be useful, but
22 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
24 ;; General Public License for more details.
26 ;; You should have received a copy of the GNU General Public License
27 ;; along with Planner; see the file COPYING. If not, write to the
28 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
29 ;; Boston, MA 02110-1301, USA.
33 ;; This file provides `planner-trunk-tasks', which groups the tasks
34 ;; according to `planner-trunk-rule-list'. Please see the docstring
35 ;; for details. Remember to customize `planner-trunk-rule-list' before
38 ;; It sorts and splits your tasks, adding a blank line between groups
41 ;; WARNING: planner-trunk will delete *ALL* non-task lines from the
42 ;; tasks section of your plan page if it attempts to trunk
43 ;; the tasks. Do NOT use it if you want to preserve this
46 ;;; Things that would be nice to do:
48 ;; - Respect hidden outline sections when trunking and rehide after
49 ;; trunk is complete if they are present.
50 ;; - If point is in the tasks section, keep point on the same line.
51 ;; Maybe can do by saving entire line text and searching for it
52 ;; afterwards. Only problem is if it is whitespace only line. If
53 ;; so, maybe can move cursor to previous non-whitespace line? Point
54 ;; obviously shouldn't move if not in Tasks section.
58 ;; Keith Amidon worked on a number of aspects of this file.
60 ;; Sergey Vlasov contributed a fix that corrected regexp syntax and
61 ;; kept the "Tasks" string from being hard-coded.
67 ;;; USER VARIABLES -----------------------------------------------------------
69 (defgroup planner-trunk nil
70 "Grouping tasks for planner.el."
71 :prefix
"planner-trunk"
74 (defcustom planner-trunk-rule-list
75 `(("\\`[0-9][0-9][0-9][0-9]\\.[0-9][0-9]\\.[0-9][0-9]\\'" nil
76 ("HomeWork" "WorkStuff"
77 "EmacsHack\\|PlannerHack")))
78 "List of rules for trunking tasks.
80 Each rule is a sublist of the form:
82 (PAGE-REGEXP COMPLETE-HEADING TRUNK-SECTIONS-LIST)
84 PAGE-REGEXP is used to select the set of trunk sections that should be
85 used. It is matched against the name of the current planner page. If
86 no matching PAGE-REGEXP is found, no trunking is done. If there is
87 more than one match, the first one in the list is used.
89 If COMPLETE-HEADING is nil, completed and not completed tasks will be
90 in the same trunk, sorted according to `planner-sort-tasks-key-function'.
91 If it is a string, it is the name of a sub-heading of the tasks
92 section under which to sort completed tasks separately, in which
93 case it will be the last subsection of the tasks section of the page.
95 Each element of TRUNK-SECTIONS-LIST describes a trunk of the page.
96 Elements can either be a simple TASK-PLAN-REGEXP, or a sublist of the form:
98 (TASK-PLAN-REGEXP TRUNK-HEADING)
100 The TASK-PLAN-REGEXP is matched against the plan page (or pages if you
101 are using planner-multi) for the task. If more than one
102 TASK-PLAN-REGEXP matches, the first one in the list is used. All
103 tasks that match the same TASK-PLAN-REGEXP will be grouped together.
104 The order of the groups will match the order of TRUNK-SECTIONS-LIST.
105 Tasks that do not match any entry in TRUNK-SECTIONS-LIST will be in a
106 separate group at the end of the tasks section. If the sublist form
107 of an entry is used, TRUNK-HEADING is a name for the outline heading
108 to be inserted at the top of the trunk. If TRUNK-SECTIONS-LIST
109 contains a mix of items in the regexp and sublist forms, when tasks
110 are present that match a regexp form entry, but no tasks are present
111 that match the most recent preceeding sublist form entry in the list,
112 the heading from the sublist form entry will be inserted anyway. In
113 use, it will become obvious why this is desirable."
116 (choice :tag
"Page regexp"
117 (const "\\`[0-9][0-9][0-9][0-9][\\.\\-][0-9][0-9][\\.\\-][0-9][0-9]\\'"
119 (const "." :tag
"All pages")
120 (regexp :tag
"Regexp"))
122 :tag
"Completed tasks"
123 (const :tag
"With incomplete tasks" nil
)
124 (string :tag
"Under section heading"))
125 (repeat (choice (regexp :tag
"Regexp")
127 :tag
"Regexp and section heading"
128 (regexp :tag
"Regexp")
129 (string :tag
"Section heading"))))))
130 :group
'planner-trunk
)
132 (defcustom planner-trunk-tasks-before-hook nil
133 "Functions to run before doing the trunk."
135 :group
'planner-trunk
)
137 (defcustom planner-trunk-tasks-after-hook nil
138 "Functions to run after the trunk is done."
140 :group
'planner-trunk
)
142 ;;;_+ Internal variables and utility functions
144 (defun planner-trunk-rule-page-regexp (rule)
145 "Regular expression matching the page in RULE."
148 (defun planner-trunk-rule-completed-heading (rule)
149 "Sub-heading for completed tasks in RULE."
152 (defun planner-trunk-rule-trunk-sections (rule)
153 "Trunk section in RULE."
156 (defun planner-trunk-list-regexp (trunk)
157 "Plan page regular expression for TRUNK."
162 (defun planner-trunk-list-heading (trunk)
168 (defun planner-trunk-task-plan-str (task-info)
169 "Return plan string for TASK-INFO."
171 (if (fboundp 'planner-multi-task-link-as-list
)
173 (planner-multi-task-link-as-list task-info
) " ")
174 (or (planner-task-link task-info
)
175 (planner-task-plan task-info
)))
178 (defun planner-trunk-completed-p (task-info)
179 "Return non-nil if TASK-INFO is a completed task."
180 (or (equal (planner-task-status task-info
) "X")
181 (equal (planner-task-status task-info
) "C")))
183 (defun planner-trunk-delete-all-blank-lines ()
184 "Delete all blank lines and insert one at the end."
185 (goto-char (point-min))
187 (while (= (forward-line 1) 0)
188 (delete-blank-lines))
191 (defun planner-trunk-delete-line-if-not-task ()
192 "Delete the current line if it is not a task."
193 (if (planner-current-task-info)
194 (not (equal (forward-line) 1))
195 (let ((bol (planner-line-beginning-position)))
196 (let ((at-end (equal (forward-line) 1)))
198 (delete-region bol
(point))
201 (defun planner-trunk-delete-non-task-lines ()
202 "Delete all lines that are not tasks. DANGEROUS."
203 (goto-char (point-min))
204 (forward-line) ; Skip Tasks heading
205 ;; (keep-lines "^#[A-C][0-9]*\\s-+.\\s-") or
206 (while (planner-trunk-delete-line-if-not-task))
210 (defun planner-trunk-sort-tasks (rule)
211 "Sort tasks by plan name according to the given RULE list."
212 (let ((trunk-list (planner-trunk-rule-trunk-sections rule
))
213 (completed-heading (planner-trunk-rule-completed-heading rule
))
214 (task-info (planner-current-task-info)))
215 (let ((trunk-count (length trunk-list
))
216 (plan (planner-trunk-task-plan-str task-info
))
217 (task-completed (planner-trunk-completed-p task-info
)))
219 (+ 2 (if (and completed-heading task-completed
)
224 (when (and completed-heading task-completed
)
225 (setq count
(+ count trunk-count
2)))
227 (lambda (trunk-entry)
228 (let ((plan-regexp (planner-trunk-list-regexp trunk-entry
)))
229 (if (string-match plan-regexp plan
)
231 (setq count
(1+ count
)))))
235 (defun planner-trunk-ins-heading (completed-heading task-info heading
)
236 "Insert the task heading.
237 If COMPLETED-HEADING is non-nil and TASK-INFO is a completed task,
238 use COMPLETED-HEADING instead of HEADING."
241 (when (and completed-heading
242 (planner-trunk-completed-p task-info
))
244 (insert "** " heading
))
247 (defun planner-trunk-do-trunk-section (rule)
248 "Really do the trunk.
250 Adds new lines and optionally outline mode subheadings according to
251 the trunk RULE. Point must be at the beginning of the section to
252 trunk, typically either the beginning of the tasks section or the
253 beginning of the completed subsection."
255 (completed-hdr (planner-trunk-rule-completed-heading rule
))
256 ;; Following adds a dummy first entry to get rid of special
257 ;; case to handle headings otherwise. It prevents anyone from
258 ;; having a plan page named (_-), which I hope no-one wants to
260 (trunk-list (cons "^\\\\(_-\\\\)$"
261 (planner-trunk-rule-trunk-sections rule
)))
262 (first-trunk (car (planner-trunk-rule-trunk-sections rule
)))
264 (while (and trunk-list not-done
)
265 (let ((task-info (planner-current-task-info)))
267 (setq ntasks
(1+ ntasks
))
268 (let ((plan (planner-trunk-task-plan-str task-info
))
269 (plan-regexp (planner-trunk-list-regexp (car trunk-list
))))
270 (unless (string-match plan-regexp plan
)
272 (while (and trunk-list
273 (not (string-match plan-regexp plan
)))
274 (setq trunk-list
(cdr trunk-list
))
276 (planner-trunk-list-regexp (car trunk-list
)))
277 (when (planner-trunk-list-heading (car trunk-list
))
279 (planner-trunk-list-heading (car trunk-list
)))))
280 (when (planner-trunk-list-heading (car trunk-list
))
281 (setq hdr
(planner-trunk-list-heading (car trunk-list
))))
282 (planner-trunk-ins-heading completed-hdr task-info hdr
)))))
283 (when (or (null trunk-list
)
284 (not (equal 0 (forward-line 1)))
286 (not (planner-trunk-completed-p task-info
))
287 (planner-trunk-completed-p (planner-current-task-info))))
288 (setq not-done nil
))))
291 (defun planner-trunk-do-trunk (rule)
292 "Really do the trunk following RULE."
293 (goto-char (point-min))
294 (planner-trunk-do-trunk-section rule
)
295 (when (planner-trunk-rule-completed-heading rule
)
296 (while (let ((task-info (planner-current-task-info)))
297 (and (not (planner-trunk-completed-p task-info
))
298 (equal 0 (forward-line)))))
299 (let ((start-completed-pos (point)))
300 (when (> (planner-trunk-do-trunk-section rule
) 0)
301 (when (stringp (planner-trunk-rule-completed-heading rule
))
302 (goto-char start-completed-pos
)
303 (insert "\n** " (planner-trunk-rule-completed-heading rule
) "\n"))))))
305 ;; user visible functions
308 (defun planner-trunk-tasks (&optional force
)
309 "Trunk(group) tasks in the current page.
310 Please refer the docstring of `planner-trunk-rule-list' for how
311 it works. You may want to call this function before you sort tasks
312 and/or after you create new tasks. If a prefix is given or FORCE is not
313 nil, trunk completed tasks together with non-completed tasks not
314 matter what the `planner-trunk-rule-list' said."
316 (let ((page-name (planner-page-name))
317 (rule-list planner-trunk-rule-list
))
318 (let ((rule (catch 'done
320 (if (string-match (caar rule-list
) page-name
)
321 (throw 'done
(car rule-list
))
322 (setq rule-list
(cdr rule-list
))))
327 (run-hooks 'planner-trunk-tasks-before-hook
)
328 (when (planner-narrow-to-section 'tasks
)
329 (planner-trunk-delete-non-task-lines)
332 (list (planner-trunk-rule-page-regexp rule
)
334 (planner-trunk-rule-trunk-sections rule
))))
335 (let ((planner-sort-tasks-key-function
337 (planner-trunk-sort-tasks rule
))))
338 (planner-sort-tasks))
339 (planner-trunk-do-trunk rule
))
340 (run-hooks 'planner-trunk-tasks-after-hook
)))))))
342 (provide 'planner-trunk
)
344 ;;; planner-trunk.el ends here