1 ;;; planner-trunk.el --- Trunk tasks for the Emacs planner
4 ;; Copyright (C) 2005 Dryice Dong Liu . All rights reserved.
5 ;; Parts copyright (C) 2005 Keith Amidon
6 ;; Parts copyright (C) 2005 Free Software Foundation, Inc.
8 ;; Keywords: emacs planner trunk group tasks
9 ;; Authors: Dryice Liu <dryice AT liu DOT com DOT cn>
10 ;; Keith Amidon <camalot AT picnicpark dot org>
11 ;; Description: trunk(group) tasks for the Emacs planner
13 ;; This file is not part of GNU Emacs.
15 ;; This is free software; you can redistribute it and/or modify it under
16 ;; the terms of the GNU General Public License as published by the Free
17 ;; Software Foundation; either version 2, or (at your option) any later
20 ;; This is distributed in the hope that it will be useful, but WITHOUT
21 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
22 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with GNU Emacs; see the file COPYING. If not, write to the
27 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
28 ;; Boston, MA 02110-1301, USA.
32 ;; This file provides `planner-trunk-tasks', which groups the tasks
33 ;; according to `planner-trunk-rule-list'. Please see the docstring
34 ;; for details. Remember to customize `planner-trunk-rule-list' before
37 ;; It sorts and splits your tasks, adding a blank line between groups
40 ;; WARNING: planner-trunk will delete *ALL* non-task lines from the
41 ;; tasks section of your plan page if it attempts to trunk
42 ;; the tasks. Do NOT use it if you want to preserve this
45 ;;; Things that would be nice to do:
46 ;; - Respect hidden outline sections when trunking and rehide after
47 ;; trunk is complete if they are present.
48 ;; - If point is in the tasks section, keep point on the same line.
49 ;; Maybe can do by saving entire line text and searching for it
50 ;; afterwards. Only problem is if it is whitespace only line. If
51 ;; so, maybe can move cursor to previous non-whitespace line? Point
52 ;; obviously shouldn't move if not in Tasks section.
56 ;; Keith Amidon worked on a number of aspects of this file.
58 ;; Sergey Vlasov contributed a fix that corrected regexp syntax and
59 ;; kept the "Tasks" string from being hard-coded.
65 ;;; USER VARIABLES -----------------------------------------------------------
67 (defgroup planner-trunk nil
68 "Grouping tasks for planner.el."
69 :prefix
"planner-trunk"
72 (defcustom planner-trunk-rule-list
73 `(("\\`[0-9][0-9][0-9][0-9]\\.[0-9][0-9]\\.[0-9][0-9]\\'" nil
74 ("HomeWork" "WorkStuff"
75 "EmacsHack\\|PlannerHack")))
76 "List of rules for trunking tasks.
78 Each rule is a sublist of the form:
80 (PAGE-REGEXP COMPLETE-HEADING TRUNK-SECTIONS-LIST)
82 PAGE-REGEXP is used to select the set of trunk sections that should be
83 used. It is matched against the name of the current planner page. If
84 no matching PAGE-REGEXP is found, no trunking is done. If there is
85 more than one match, the first one in the list is used.
87 If COMPLETE-HEADING is nil, completed and not completed tasks will be
88 in the same trunk, sorted according to `planner-sort-tasks-key-function'.
89 If it is a string, it is the name of a sub-heading of the tasks
90 section under which to sort completed tasks separately, in which
91 case it will be the last subsection of the tasks section of the page.
93 Each element of TRUNK-SECTIONS-LIST describes a trunk of the page.
94 Elements can either be a simple TASK-PLAN-REGEXP, or a sublist of the form:
96 (TASK-PLAN-REGEXP TRUNK-HEADING)
98 The TASK-PLAN-REGEXP is matched against the plan page (or pages if you
99 are using planner-multi) for the task. If more than one
100 TASK-PLAN-REGEXP matches, the first one in the list is used. All
101 tasks that match the same TASK-PLAN-REGEXP will be grouped together.
102 The order of the groups will match the order of TRUNK-SECTIONS-LIST.
103 Tasks that do not match any entry in TRUNK-SECTIONS-LIST will be in a
104 separate group at the end of the tasks section. If the sublist form
105 of an entry is used, TRUNK-HEADING is a name for the outline heading
106 to be inserted at the top of the trunk. If TRUNK-SECTIONS-LIST
107 contains a mix of items in the regexp and sublist forms, when tasks
108 are present that match a regexp form entry, but no tasks are present
109 that match the most recent preceeding sublist form entry in the list,
110 the heading from the sublist form entry will be inserted anyway. In
111 use, it will become obvious why this is desirable."
114 (choice :tag
"Page regexp"
115 (const "\\`[0-9][0-9][0-9][0-9]\\.[0-9][0-9]\\.[0-9][0-9]\\'"
117 (const "." :tag
"All pages")
118 (regexp :tag
"Regexp"))
120 :tag
"Completed tasks"
121 (const :tag
"With incomplete tasks" nil
)
122 (string :tag
"Under section heading"))
123 (repeat (choice (regexp :tag
"Regexp")
125 :tag
"Regexp and section heading"
126 (regexp :tag
"Regexp")
127 (string :tag
"Section heading"))))))
128 :group
'planner-trunk
)
130 (defcustom planner-trunk-tasks-before-hook nil
131 "Functions to run before doing the trunk."
133 :group
'planner-trunk
)
135 (defcustom planner-trunk-tasks-after-hook nil
136 "Functions to run after the trunk is done."
138 :group
'planner-trunk
)
140 ;;;_+ Internal variables and utility functions
142 (defun planner-trunk-rule-page-regexp (rule)
143 "Regular expression matching the page in RULE."
146 (defun planner-trunk-rule-completed-heading (rule)
147 "Sub-heading for completed tasks in RULE."
150 (defun planner-trunk-rule-trunk-sections (rule)
151 "Trunk section in RULE."
154 (defun planner-trunk-list-regexp (trunk)
155 "Plan page regular expression for TRUNK."
160 (defun planner-trunk-list-heading (trunk)
166 (defun planner-trunk-task-plan-str (task-info)
167 "Return plan string for TASK-INFO."
169 (if (fboundp 'planner-multi-task-link-as-list
)
171 (planner-multi-task-link-as-list task-info
) " ")
172 (or (planner-task-link task-info
)
173 (planner-task-plan task-info
)))
176 (defun planner-trunk-completed-p (task-info)
177 "Return non-nil if TASK-INFO is a completed task."
178 (or (equal (planner-task-status task-info
) "X")
179 (equal (planner-task-status task-info
) "C")))
181 (defun planner-trunk-delete-all-blank-lines ()
182 "Delete all blank lines and insert one at the end."
183 (goto-char (point-min))
185 (while (= (forward-line 1) 0)
186 (delete-blank-lines))
189 (defun planner-trunk-delete-line-if-not-task ()
190 "Delete the current line if it is not a task."
191 (if (planner-current-task-info)
192 (not (equal (forward-line) 1))
193 (let ((bol (planner-line-beginning-position)))
194 (let ((at-end (equal (forward-line) 1)))
196 (delete-region bol
(point))
199 (defun planner-trunk-delete-non-task-lines ()
200 "Delete all lines that are not tasks. DANGEROUS."
201 (goto-char (point-min))
202 (forward-line) ; Skip Tasks heading
203 ;; (keep-lines "^#[A-C][0-9]*\\s-+.\\s-") or
204 (while (planner-trunk-delete-line-if-not-task))
208 (defun planner-trunk-sort-tasks (rule)
209 "Sort tasks by plan name according to the given RULE list."
210 (let ((trunk-list (planner-trunk-rule-trunk-sections rule
))
211 (completed-heading (planner-trunk-rule-completed-heading rule
))
212 (task-info (planner-current-task-info)))
213 (let ((trunk-count (length trunk-list
))
214 (plan (planner-trunk-task-plan-str task-info
))
215 (task-completed (planner-trunk-completed-p task-info
)))
217 (+ 2 (if (and completed-heading task-completed
)
222 (when (and completed-heading task-completed
)
223 (setq count
(+ count trunk-count
2)))
225 (lambda (trunk-entry)
226 (let ((plan-regexp (planner-trunk-list-regexp trunk-entry
)))
227 (if (string-match plan-regexp plan
)
229 (setq count
(1+ count
)))))
233 (defun planner-trunk-ins-heading (completed-heading task-info heading
)
234 "Insert the task heading.
235 If COMPLETED-HEADING is non-nil and TASK-INFO is a completed task,
236 use COMPLETED-HEADING instead of HEADING."
239 (when (and completed-heading
240 (planner-trunk-completed-p task-info
))
242 (insert "** " heading
))
245 (defun planner-trunk-do-trunk-section (rule)
246 "Really do the trunk.
248 Adds new lines and optionally outline mode subheadings according to
249 the trunk RULE. Point must be at the beginning of the section to
250 trunk, typically either the beginning of the tasks section or the
251 beginning of the completed subsection."
253 (completed-hdr (planner-trunk-rule-completed-heading rule
))
254 ;; Following adds a dummy first entry to get rid of special
255 ;; case to handle headings otherwise. It prevents anyone from
256 ;; having a plan page named (_-), which I hope no-one wants to
258 (trunk-list (cons "^\\\\(_-\\\\)$"
259 (planner-trunk-rule-trunk-sections rule
)))
260 (first-trunk (car (planner-trunk-rule-trunk-sections rule
)))
262 (while (and trunk-list not-done
)
263 (let ((task-info (planner-current-task-info)))
265 (setq ntasks
(1+ ntasks
))
266 (let ((plan (planner-trunk-task-plan-str task-info
))
267 (plan-regexp (planner-trunk-list-regexp (car trunk-list
))))
268 (unless (string-match plan-regexp plan
)
270 (while (and trunk-list
271 (not (string-match plan-regexp plan
)))
272 (setq trunk-list
(cdr trunk-list
))
274 (planner-trunk-list-regexp (car trunk-list
)))
275 (when (planner-trunk-list-heading (car trunk-list
))
277 (planner-trunk-list-heading (car trunk-list
)))))
278 (when (planner-trunk-list-heading (car trunk-list
))
279 (setq hdr
(planner-trunk-list-heading (car trunk-list
))))
280 (planner-trunk-ins-heading completed-hdr task-info hdr
)))))
281 (when (or (null trunk-list
)
282 (not (equal 0 (forward-line 1)))
284 (not (planner-trunk-completed-p task-info
))
285 (planner-trunk-completed-p (planner-current-task-info))))
286 (setq not-done nil
))))
289 (defun planner-trunk-do-trunk (rule)
290 "Really do the trunk following RULE."
291 (goto-char (point-min))
292 (planner-trunk-do-trunk-section rule
)
293 (when (planner-trunk-rule-completed-heading rule
)
294 (while (let ((task-info (planner-current-task-info)))
295 (and (not (planner-trunk-completed-p task-info
))
296 (equal 0 (forward-line)))))
297 (let ((start-completed-pos (point)))
298 (when (> (planner-trunk-do-trunk-section rule
) 0)
299 (when (stringp (planner-trunk-rule-completed-heading rule
))
300 (goto-char start-completed-pos
)
301 (insert "\n** " (planner-trunk-rule-completed-heading rule
) "\n"))))))
303 ;; user visible functions
306 (defun planner-trunk-tasks (&optional force
)
307 "Trunk(group) tasks in the current page.
308 Please refer the docstring of `planner-trunk-rule-list' for how
309 it works. You may want to call this function before you sort tasks
310 and/or after you create new tasks. If a prefix is given or FORCE is not
311 nil, trunk completed tasks together with non-completed tasks not
312 matter what the `planner-trunk-rule-list' said."
314 (let ((page-name (planner-page-name))
315 (rule-list planner-trunk-rule-list
))
316 (let ((rule (catch 'done
318 (if (string-match (caar rule-list
) page-name
)
319 (throw 'done
(car rule-list
))
320 (setq rule-list
(cdr rule-list
))))
325 (run-hooks 'planner-trunk-tasks-before-hook
)
326 (when (planner-narrow-to-section 'tasks
)
327 (planner-trunk-delete-non-task-lines)
330 (list (planner-trunk-rule-page-regexp rule
)
332 (planner-trunk-rule-trunk-sections rule
))))
333 (let ((planner-sort-tasks-key-function
335 (planner-trunk-sort-tasks rule
))))
336 (planner-sort-tasks))
337 (planner-trunk-do-trunk rule
))
338 (run-hooks 'planner-trunk-tasks-after-hook
)))))))
340 (provide 'planner-trunk
)
342 ;;; planner-trunk.el ends here