Remove broken link to Remember documentation.
[planner-el.git] / planner.el
blob5dce05b3e49f85bde478298f18530d238cc88802
1 ;;; planner.el --- The Emacs Planner
3 ;;; Commentary:
5 ;;;_* Commentary
7 ;;;_ + Package description
9 ;; Copyright (C) 2001, 2003, 2004, 2005,
10 ;; 2006, 2007, 2008, 2010 Free Software Foundation, Inc.
11 ;; Parts copyright (C) 2004, 2008 David D. Smith (davidsmith AT acm DOT org)
12 ;; Parts copyright (C) 2004, 2008 Yvonne Thomson (yvonne AT netbrains DOT com DOT au)
13 ;; Parts copyright (C) 2004, 2008 Maciej Kalisak (mac AT cs DOT toronto DOT edu)
14 ;; Parts copyright (C) 2004, 2008 Chris Parsons (chris.p AT rsons.org)
15 ;; Parts copyright (C) 2004, 2008 Dirk Bernhardt (nospam AT krid.de)
16 ;; Parts copyright (C) 2005, 2008 Dryice Dong Liu
17 ;; Parts copyright (C) 2005, 2008 Angus Lees (gus AT debian.org)
18 ;; Parts copyright (C) 2005, 2008 Sergey Vlasov (vsu AT altlinux.ru)
19 ;; Parts copyright (C) 2005, 2008 Yann Hodique (hodique AT lifl DOT fr)
20 ;; Parts copyright (C) 2005, 2008 Peter K. Lee
21 ;; Parts copyright (C) 2006, 2007 Software Freedom Law Center
23 ;; Emacs Lisp Archive Entry
24 ;; Filename: planner.el
25 ;; Version: 3.42
26 ;; Keywords: hypermedia
27 ;; Author: John Wiegley <johnw@gnu.org>
28 ;; Maintainer: John Sullivan <john@wjsullivan.net>
29 ;; Description: Use Emacs for life planning
30 ;; URL: http://www.wjsullivan.net/PlannerMode.html
31 ;; Bugs: https://gna.org/bugs/?group=planner-el
32 ;; Compatibility: Emacs21, Emacs22, Emacs23, XEmacs21
34 ;; This file is part of Planner. It is not part of GNU Emacs.
36 ;; Planner is free software; you can redistribute it and/or modify it
37 ;; under the terms of the GNU General Public License as published by
38 ;; the Free Software Foundation; either version 3, or (at your option)
39 ;; any later version.
41 ;; Planner is distributed in the hope that it will be useful, but
42 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
43 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
44 ;; General Public License for more details.
46 ;; You should have received a copy of the GNU General Public License
47 ;; along with Planner; see the file COPYING. If not, write to the
48 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
49 ;; Boston, MA 02110-1301, USA.
51 ;;;_ + Usage
53 ;; Place planner.el in your load path and add this to your .emacs:
55 ;; (require 'planner)
57 ;; By default and for backward compatibility, the following operations
58 ;; do not have keybindings, and are only accessible from the Planner
59 ;; menu:
61 ;; planner-copy-or-move-region
62 ;; planner-delete-task
63 ;; planner-task-delegated
64 ;; planner-task-pending
65 ;; planner-fix-tasks
67 ;; You may find it easier to install keybindings for those operations by
68 ;; inserting the following in your .emacs file:
70 ;; ;; Note: This changes some of the default key bindings for planner-mode
71 ;; (planner-install-extra-task-keybindings)
73 ;; If you want to change `planner-directory' and some other variables,
74 ;; either use Customize or use `setq'. For example:
76 ;; (setq planner-directory "~/Plans")
78 ;; You can customize Planner. M-x customize-group RET planner RET
79 ;; or see the Options section.
81 ;;; Note:
83 ;; This package extends Emacs Muse to act as a day planner, roughly
84 ;; equivalent to the one used by Franklin-Covey. If they have patents
85 ;; and trademarks and copyrights to prevent me even thinking in terms
86 ;; of their methodology, then I can't believe they care at all about
87 ;; productivity.
89 ;;;_ + Summary
91 ;; * Make a planning file
93 ;; Open a wiki file within your planning directory. By default,
94 ;; planner-directory is set to "~/Plans". You may have to use C-x C-f
95 ;; to open the file.
97 ;; A plan file generally describes a long-term plan. For example, you
98 ;; could make a plan file for your ThesisProject or your
99 ;; ContinuousLearning. Planner.el can help you organize related ideas,
100 ;; tasks and resources into a coherent plan.
102 ;; * Break your plan into stages
104 ;; Start the file with your "vision", or the goal you intend to
105 ;; accomplish. Break this up into parts, and create a Wiki file for
106 ;; each part, with defined milestones which constitute the "goal" for
107 ;; that part.
109 ;; * Write out the tasks for each stage
111 ;; In each sub-plan, list out the tasks necessary to accomplish the
112 ;; milestone. Write them into the file like this:
114 ;; #A _ 1h Call so and so to make a reservation
116 ;; * Decide on a priority for each task
118 ;; The A is the priority of the task. The _ means it isn't done yet,
119 ;; and the 1h is a quick estimate on how long it will task. The time
120 ;; estimates are optional.
122 ;; The priorities break down like this:
124 ;; A: if you don't do it, your plan will be compromised, and you
125 ;; will have to either abort, backtrack, or make profuse apologies
126 ;; to someone
128 ;; B: if you don't do it, your plan will be delayed
130 ;; C: the plan won't be complete until it's done, but there's no
131 ;; pressure to do it now
133 ;; * Schedule the tasks
135 ;; Put your cursor on a line containing a task, and type C-c C-c.
136 ;; This will copy the task to a specific day, which you will be
137 ;; prompted for. The Emacs Calendar pops up, so you can pick a free
138 ;; day (if you use the Emacs diary and appointment system, the
139 ;; Calendar is even more useful).
141 ;; You will now see your new task, with a link back to your planning
142 ;; page. Selecting this link will take you back to that task on the
143 ;; planning page, where you will see that the planning page's task now
144 ;; has a link to the particular day you scheduled the task for.
146 ;; The two tasks (the one on the planning page, and the one on the
147 ;; daily task list) are linked. Changing the status of one (using C-c
148 ;; C-x, or C-c C-s, for example) will change the status of the other.
149 ;; If you forward the task to another day (using C-c C-c on the daily
150 ;; task page), the planning page's link will be updated to refer to
151 ;; the new day. This is so that you can focus on your daily task list
152 ;; during the day, but see an overview of your plan's progress at any
153 ;; time.
155 ;; * Do the work
157 ;; That's it, as far as what planner.el can do. As you complete tasks
158 ;; each day, they will disappear from view. This only happens for
159 ;; today's completed and forwarded tasks.
161 ;; Planning is an art, just as estimating time is an art. It happens
162 ;; with practice, and by thinking about these things. The Commentary
163 ;; below provides a few of my own thoughts on the matter, although I
164 ;; will say that this an art I have yet to truly develop.
166 ;; The `COMMENTARY' file has John Wiegley's original commentary.
168 ;;;_ + And now back to technical matters
170 ;; In order to refresh and renumber all of your tasks according to their
171 ;; actual order in the buffer, simply save the file or call
172 ;; M-x planner-fix-tasks .
174 ;; Here is a summary of the keystrokes available, including a few I
175 ;; did not mention:
177 ;; M-x plan Begin your planning session. This goes to the last
178 ;; day for which there is any planning info (or today if
179 ;; none), allowing you to review, and create/move tasks
180 ;; from that day.
182 ;; C-M-p Raise a task's priority
183 ;; C-M-n Lower a task's priority
185 ;; C-c C-s Mark the task as in progress or delegated
186 ;; C-c C-x Mark the task as finished
188 ;; C-c C-t Create a task associated with the current Wiki page
189 ;; If you are on the opening line of a Note entry, it is
190 ;; assume that the note itself is the origin of the task.
191 ;; C-c C-c Move or copy the current task to another date
192 ;; If the current task is an original (meaning you are in
193 ;; the buffer where's defined, hopefully a planning page)
194 ;; then it will be copied, and the original task will also
195 ;; now point to the copy. If the current task is a copy,
196 ;; it will just be moved to the new day, and the original
197 ;; tasks link will be updated.
199 ;; C-c C-n Jump to today's task page
201 ;; If you call (planner-calendar-insinuate), typing 'n' in the Emacs
202 ;; calendar will jump to today's task page.
204 ;;;_ + Planning and schedules
206 ;; Sometimes you will have appointments during the day to schedule,
207 ;; which "block out" time that might otherwise be spent on tasks.
208 ;; Users are encouraged to use the Emacs Calendar for this, along with
209 ;; Diary Mode (see the Emacs manual)
212 ;; However, there is a way to do scheduling directly in planner-mode.
213 ;; It requires the external tool "remind" (Debian users type "apt-get
214 ;; install remind". All others go to
215 ;; http://www.roaringpenguin.com/penguin/open_source_remind.php)
217 ;; Once you have remind installed, you will need two scripts in your
218 ;; local bin directory (/usr/local/bin, $HOME/bin, wherever). These
219 ;; scripts can be downloaded from my web site:
221 ;; http://sacha.free.net.ph/notebook/emacs/plan2rem
222 ;; http://sacha.free.net.ph/notebook/emacs/rem2diary
224 ;; Also, download
226 ;; http://sacha.free.net.ph/notebook/emacs/remind.el
228 ;; and put it somewhere in your load path. Take a look at remind.el
229 ;; for more details. You will need to edit a few things to get it
230 ;; to work.
232 ;; Lastly, here is another snippet for your .emacs file. It creates a
233 ;; keybinding in planner-mode, C-c C-w, which jumps you to the
234 ;; Schedule section of that file.
236 ;; (defun planner-goto-schedule ()
237 ;; (interactive)
238 ;; (goto-char (point-min))
239 ;; (unless (re-search-forward "^\\* Schedule\n\n" nil t)
240 ;; (re-search-forward "^\\* Notes")
241 ;; (beginning-of-line)
242 ;; (insert "* Schedule\n\n\n\n")
243 ;; (forward-line -2)))
245 ;; (eval-after-load "planner"
246 ;; '(progn
247 ;; (define-key planner-mode-map [(control ?c) (control ?w)]
248 ;; 'planner-goto-schedule)))
250 ;; The contents of a scheduling section look like this, which is
251 ;; rendered in HTML as a table:
253 ;; * Schedule
255 ;; 8:00 | Wake up
256 ;; 14:00 | Go to the dentist (2:00)
257 ;; 18:00 | Watch TV
259 ;; The start time is given in 24-hour time, with an optional duration
260 ;; occuring in parentheses at the end of the description hs-show(in
261 ;; HOURS:MINUTES). And off you go!
263 ;; You can also organize this as
265 ;; 8:00 | 8:30 | Wake up
266 ;; 14:00 | 16:00 | Go to the dentist
267 ;; 18:00 | 21:00 | Watch TV
269 ;;;_ + Example planning file
271 ;; The format of a planning file is given below. You are responsible
272 ;; for keeping it looking like this. I intentionally did not make
273 ;; planner.el heavy on the UI side of things, too keep it more
274 ;; free-form and open. This lets you adapt it to whatever your
275 ;; particular preferences might be.
277 ;;----------------------------------------------------------------------
278 ;; * Tasks
280 ;; #A1 _ An open task, very important!
281 ;; #A2 X A closed task (MyPlan)
282 ;; #A3 o A task that's delayed, or delegated (MyPlan)
284 ;; * Notes
286 ;; .#1 This is note number one
288 ;; Notes on note number one!
290 ;; .#2 This weird ".#2" syntax is used because it's what allout.el
291 ;; likes for enumerated lists, and it makes using
292 ;; outline-minor-mode (with allout) very handy. You can omit the
293 ;; leading period if you like, though. It's optional.
295 ;; ----------------------------------------------------------------------
297 ;;;_ + Other packages that come with the Planner distribution
299 ;; planner-bbdb.el | Link to your contacts
300 ;; planner-diary.el | Thomas Gehrlein's diary integration
301 ;; planner-gnus.el | Link to your mail/news messages
302 ;; planner-id.el | Automatically add unique task IDs
303 ;; planner-notes.el | Create a note index
304 ;; planner-rss.el | Publish your notes as an RSS feed
305 ;; planner-schedule.el | Estimate task completion time
306 ;; planner-timeclock.el | Clock in and clock out
307 ;; planner-w3m.el | Make tasks based on W3M buffers
308 ;; remember.el | Easily remember short notes
310 ;;;_ + Thanks
312 ;; A short, partial list of contributors, those who reported bugs, and
313 ;; those who gave valuable suggestions can be found at
314 ;; http://sacha.free.net.ph/notebook/wiki/PlannerMode.php
316 ;;;_ + Contributors
318 ;; David D. Smith (davidsmith AT acm DOT org) helped links to planner
319 ;; pages be created properly, among other things.
321 ;; Frederik Fouvry fixed a match error by using grouping.
323 ;; Daniel Neri (dne AT mayonnaise DOT net) fixed a couple of typos.
325 ;; Mario Peter (email address unknown) made
326 ;; `planner-in-progress-task-face' use :bold instead of :slant if
327 ;; using XEmacs.
329 ;; Yvonne Thomson (yvonne AT netbrains DOT com DOT au) contributed
330 ;; `planner-annotation-from-info'.
332 ;; Hoan Ton-That (hoan AT ton-that DOT org) had the idea to strip the
333 ;; directory from planner file annotations and contributed the base
334 ;; patch.
336 ;; Michael Olson (mwolson AT gnu DOT org) contributed XHTML 1.1
337 ;; patches, fixed some bugs that irked him, and did a few other
338 ;; miscellaneous things.
340 ;; Maciej Kalisiak (mac AT cs DOT toronto DOT edu) made a patch that
341 ;; sorts dated tasks before undated ones. Maciej also helped with the
342 ;; separation of the sorting and renumbering processes.
344 ;; Dale P. Smith (dsmich AT adelphia DOT net) contributed a small
345 ;; patch that fixes tasks that are not true wiki names.
347 ;; Stefan Reichör (stefan AT xsteve DOT at) contributed a small patch
348 ;; that saves only modified buffers, and some other patches as well.
350 ;; Chris Parsons made it so that C-u means put note on plan page.
352 ;; Dirk Bernhardt contributed a patch that added the
353 ;; `planner-default-tasks-status' option.
355 ;; Jim Ottaway provided several bugfixes.
357 ;; Dryice Dong Liu made the place to put the annotation in the task
358 ;; description configurable.
360 ;; Angus Lees provided a patch to make planner-sort-tasks stop causing
361 ;; backtraces.
363 ;; Yann Hodique (hodique AT lifl DOT fr) fixed a number of problems
364 ;; with the Muse port of Planner.
366 ;; Peter K. Lee (saint AT corenova DOT com) fixed a few initial errors
367 ;; with missing and malformed functions like `planner-page-exists-p'
368 ;; and `planner-option-customized'
370 ;; Romain Francoise improved match data handling in
371 ;; `planner-browse-position-url'.
373 ;; Win Treese fixed a bug in `planner-save-buffers'.
375 ;; Sven Kloppenburg fixed a regexp.
377 ;; Sergey Vlasov fixed several bugs.
379 ;; Marco Gidde provided a patch that allows Planner to visit a link to
380 ;; a temporary file by visiting its buffer.
382 ;; Trent Buck made things work better when day pages are disabled.
384 ;; Andrew J. Korty made it so that task padding is only used if
385 ;; `planner-use-task-numbers' is non-nil.
387 ;;; Code:
389 ;;;_* Prerequisites
391 (require 'muse-colors)
392 (require 'muse-mode)
393 (require 'muse-project)
394 (require 'muse-html)
395 (require 'sort)
396 (require 'calendar)
397 (require 'font-lock)
398 (require 'info)
399 (require 'easymenu)
400 (condition-case nil
401 (require 'derived)
402 (error nil))
403 (condition-case nil
404 (require 'overlay)
405 (error nil))
407 (defvar planner-loaded nil)
408 (defvar planner-version "3.42"
409 "The version of Planner currently loaded.")
411 ;; Compatibility hacks -- these will be removed in the future
413 (defun planner-update-wiki-project ()
414 ;; do nothing
416 (defvar planner-markup-tags nil)
418 (defun planner-option-customized (sym val)
419 "Set SYM to VAL and update the WikiPlanner project."
420 (set sym val)
421 (when planner-loaded
422 (planner-update-wiki-project)))
424 (defun planner-split-string (string &optional separators omit-nulls)
425 ;; OMIT-NULLS was added in Emacs 22. Remove this when we stop supporting
426 ;; anything before 22, and replace all uses with `split-string'.
427 (let ((res (split-string string separators)))
428 (if omit-nulls
429 (delete "" res)
430 res)))
432 ;;;_* Options
434 (defgroup planner nil
435 "A personal information manager for Emacs."
436 :prefix "planner-"
437 :group 'applications)
439 (defcustom planner-project "WikiPlanner"
440 "The name of this project in `muse-project-alist'."
441 :type 'string
442 :group 'planner)
444 (defcustom planner-initial-page "WelcomePage"
445 "The name of the root plan page that `plan' will find when not
446 using day pages. If you are using day pages (the default), this
447 option is not used."
448 :type 'string
449 :group 'planner)
451 (defcustom planner-publish-dates-first-p nil
452 "Non-nil means put day pages at the top of the index."
453 :type 'boolean
454 :group 'planner)
456 (defcustom planner-use-day-pages t
457 "If non-nil, allow the use of day pages.
458 You can set this to nil if you use plan pages exclusively and
459 don't want to be prompted for dates. If so, then `plan' will
460 bring up the `planner-initial-page' of your planner wiki."
461 :type 'boolean
462 :group 'planner)
464 (defcustom planner-use-plan-pages t
465 "If non-nil, allow the use of plan pages.
466 You can set this to nil if you use day pages exclusively and
467 don't want to be prompted for plans."
468 :type 'boolean
469 :group 'planner)
471 (defcustom planner-mode-hook nil
472 "A hook for Planner mode."
473 :type 'hook
474 :group 'planner)
476 (defcustom planner-annotation-functions
477 '(planner-annotation-from-planner-note
478 planner-annotation-from-planner
479 planner-annotation-from-wiki
480 planner-annotation-from-dired
481 planner-annotation-from-info
482 planner-annotation-from-man
483 planner-annotation-from-woman
484 planner-annotation-from-file-with-position)
485 "Functions tried in order by `planner-create-task-from-buffer'.
486 To change the behavior of `planner-create-task-from-buffer',
487 remove, change the order of, or insert functions in this list."
488 :type 'hook
489 :group 'planner)
491 (defcustom planner-annotation-symbol-string "{}"
492 "The string to be replaced by annotation from `planner-annotation-functions'.
493 If nil or not found in the task title, the annotation will be
494 added to the end."
495 :type 'string
496 :group 'planner)
498 (defcustom planner-use-other-window t
499 "If non-nil, Planner will open planner files in another window."
500 :type 'boolean
501 :group 'planner)
503 (defcustom planner-show-only-existing t
504 "If non-nil, `planner-show' only shows existing files."
505 :type 'boolean
506 :group 'planner)
508 (defcustom planner-reverse-chronological-notes t
509 "*If non-nil, notes are added to the beginning of the section."
510 :type 'boolean
511 :group 'planner)
513 (defcustom planner-create-section-function 'planner-create-at-top
514 "Called when creating a new section.
515 Some functions you can use are `planner-create-at-top' and
516 `planner-create-at-bottom'."
517 :type 'function
518 :group 'planner)
520 (defcustom planner-template-fuzz-factor 5
521 "Controls the fuzziness of `planner-page-default-p'.
522 Right now, this is the number of additional characters over
523 `planner-day-page-template' allowed in a buffer before
524 `planner-page-default-p' assumes it has been modified."
525 :type 'integer
526 :group 'planner)
528 (defcustom planner-calendar-show-planner-files t
529 "If non-nil, shows a plan file every time a day is selected in Calendar."
530 :type 'boolean
531 :group 'planner)
533 (defcustom planner-day-page-template
534 "* Tasks\n\n\n* Schedule\n\n\n* Notes\n\n\n"
535 "Template to be inserted into blank daily pages.
536 If this is a string, it will be inserted into the blank page. If
537 this is a function, it will be called with no arguments from a
538 blank planner page and should insert the template.
540 If you want to change the name of special sections like Tasks and Notes,
541 update the `planner-sections' option as well."
542 :type '(choice
543 (string :tag "Template")
544 (function :tag "Function"))
545 :group 'planner)
547 (defcustom planner-plan-page-template "* Tasks\n\n\n* Notes\n\n\n"
548 "Template to be inserted into blank plan pages.
549 If this is a string, it will be inserted into the blank page. If
550 this is a function, it will be called with no arguments from a
551 blank planner page and should insert the template.
553 If you want to change the name of special sections like Tasks and Notes,
554 update the `planner-sections' option as well."
555 :type '(choice
556 (string :tag "Template")
557 (function :tag "Function"))
558 :group 'planner)
560 (defcustom planner-default-section 'tasks
561 "Default section when you use `planner-goto' to open a page.
562 If this is a string, it should be a section name. If this is a symbol,
563 the section name is looked up in `planner-sections'."
564 :type '(choice (string :tag "String")
565 (symbol :tag "Symbol"))
566 :group 'planner)
568 (defcustom planner-sections '((tasks . "Tasks")
569 (notes . "Notes"))
570 "Special sections in pages.
571 This option makes it easier to change the names of your sections
572 without modifying a lot of Planner code. If you change this, you
573 may also want to change `planner-day-page-template' and
574 `planner-plan-page-template'. You normally don't need to change
575 these, though."
576 :type '(alist :key symbol :value string)
577 :group 'planner)
579 (defcustom planner-ignored-from-addresses
580 (and user-mail-address
581 (not (string= user-mail-address ""))
582 (regexp-quote user-mail-address))
583 "Regexp of From headers that may be suppressed in favor of To headers."
584 :group 'planner
585 :type 'regexp)
587 (defcustom planner-dates-relative-to-today-flag nil
588 "Non-nil means relative dates (+1, -1) are always based on today.
589 By default, dates are based on the current page."
590 :group 'planner
591 :type 'boolean)
593 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
594 ;; Task options
595 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
597 (defgroup planner-tasks nil
598 "Planner options related to tasks."
599 :prefix "planner-"
600 :group 'planner)
602 ; Note that if you add another choice other than '.' or '-' here, you'll need
603 ; to grep through the code for [\\.\\-] and replace it with a regex that matches
604 ; all possible date-separators. I thought about making a variable that builds
605 ; all the regexes used elsewhere, but it made the code messy, it seemed, and
606 ; I didn't imagine too many other separators people would want. Myabe '/', but
607 ; that would cause it's own world of hurt. -- bkuhn, 2007-01-09
609 (defcustom planner-date-separator "."
610 "This character will be used to separate year, month and day numbers
611 when formatting dates"
612 :type '(choice
613 (const :tag "Dates should be in the form YYYY.MM.DD" ".")
614 (const :tag "Dates should be in the form YYYY-MM-DD" "-"))
615 :group 'planner)
617 (defcustom planner-carry-tasks-forward 3
618 "If non-nil, carry unfinished tasks forward automatically.
619 If a positive integer, scan that number of days in the past.
620 If 0, scan all days for unfinished tasks.
621 If t, scan one day in the past (old behavior).
622 If nil, do not carry unfinished tasks forward."
623 :type '(choice
624 (const :tag "Scan all days" 0)
625 (const :tag "Scan most recent day" t)
626 (const :tag "Do not carry tasks forward" nil)
627 (integer :tag "Number of days to scan"))
628 :group 'planner-tasks)
630 (defcustom planner-marks-regexp "[_oXDCP]"
631 "Regexp that matches status character for a task."
632 :type 'regexp
633 :group 'planner-tasks)
635 (defcustom planner-default-task-priority "B"
636 "Default priority for new tasks created with `planner-create-task'."
637 :type 'string
638 :group 'planner-tasks)
640 (defcustom planner-default-task-status "_"
641 "Default status for new tasks created with `planner-create-task'."
642 :type 'string
643 :group 'planner-tasks)
645 (defcustom planner-add-task-at-end-flag nil
646 "*Non-nil means create tasks at the bottom of the first task block."
647 :group 'planner-tasks
648 :type 'boolean)
650 ;;; Muse
652 ;;;_* Keybindings
655 (defvar planner-mode-map
656 (let ((map (make-sparse-keymap)))
657 (cond
658 ;; XEmacs
659 ((featurep 'xemacs)
660 (set-keymap-parents map muse-mode-map))
661 ;; Emacs
662 ((fboundp 'set-keymap-parent)
663 (set-keymap-parent map muse-mode-map))
664 ;; if we can't inherit the keymap, copy it instead
665 (t (setq map (copy-keymap muse-mode-map))))
666 (define-key map "\C-c\C-n" 'planner-goto-today)
667 ;; moving between daily pages C-c C-j for goto (used to be C-g,
668 ;; but that was confusing)
669 (define-key map "\C-c\C-j\C-d" 'planner-goto) ; goto date
670 (when planner-use-day-pages
671 (define-key map "\C-c\C-j\C-p" 'planner-goto-previous-daily-page)
672 (define-key map "\C-c\C-j\C-n" 'planner-goto-next-daily-page)
673 (define-key map "\C-c\C-j\C-j" 'planner-goto-today) ; for easy typing
674 (define-key map "\C-c\C-j\C-y" 'planner-goto-yesterday)
675 (define-key map "\C-c\C-j\C-t" 'planner-goto-tomorrow)
676 (define-key map "\C-c\C-j\C-r" 'planner-goto-most-recent)) ; recent
678 (define-key map "\C-c\C-t" 'planner-create-task-from-buffer)
679 (define-key map "\C-c\C-c" 'planner-copy-or-move-task)
680 (define-key map "\C-c\C-u" 'planner-raise-task)
681 (define-key map "\C-c\C-d" 'planner-lower-task)
683 (define-key map "\M-p" 'planner-raise-task)
684 (define-key map "\M-n" 'planner-lower-task)
686 (define-key map "\M-\C-p" 'planner-raise-task-priority)
687 (define-key map "\M-\C-n" 'planner-lower-task-priority)
689 (define-key map "\C-c\C-z" 'planner-task-in-progress)
690 (define-key map "\C-c\C-x" 'planner-task-done)
691 (define-key map '[(control ?c) (control ?X)] 'planner-task-cancelled)
692 map)
693 "Keymap used by Planner mode.")
695 (defun planner-install-extra-context-keybindings ()
696 "Install extra context-sensitive keybindings.
697 These keybindings conflict with windmove.el, but might
698 be useful.
700 On a task or note, the following keys will move around:
702 Shift-up: `planner-move-up'
703 Shift-down: `planner-move-down'
704 Shift-right: `planner-jump-to-link'"
705 (interactive)
706 (let ((map planner-mode-map))
707 (define-key map [(shift up)] 'planner-move-up)
708 (define-key map [(shift down)] 'planner-move-down)
709 (define-key map [(shift right)] 'planner-jump-to-link)))
711 ;;; Additional keybindings thanks to Thomas Gehrlein
713 (defun planner-install-extra-task-keybindings ()
714 "Install additional task key bindings.
715 Warning! Overwrites some standard key bindings. See function
716 definition for keys added."
717 (let ((map planner-mode-map))
718 (define-key map "\C-c\C-t" nil)
719 (define-key map "\C-c\C-t\C-t" 'planner-create-task-from-buffer)
720 (define-key map "\C-c\C-t\C-k" 'planner-delete-task)
721 (define-key map "\C-c\C-t\C-u" 'planner-update-task)
722 (define-key map "\C-c\C-t\C-c" 'planner-copy-or-move-task)
723 (define-key map '[(control ?c) (control ?t) (control ?C)]
724 'planner-copy-or-move-region)
725 (define-key map "\C-c\C-t\C-x" 'planner-task-done)
726 (define-key map '[(control ?c) (control ?t) (control ?X)]
727 'planner-task-cancelled)
728 (define-key map "\C-c\C-t\C-d" 'planner-task-delegated)
729 (define-key map "\C-c\C-t\C-p" 'planner-task-pending)
730 (define-key map "\C-c\C-t\C-o" 'planner-task-in-progress)
731 (define-key map "\C-c\C-t\C-r" 'planner-raise-task)
732 (define-key map "\C-c\C-t\C-l" 'planner-lower-task)
733 (define-key map "\C-c\C-t\C-n" 'planner-fix-tasks)))
735 ;;; We need some keybindings for note-related functions, too
737 (defun planner-install-extra-note-keybindings ()
738 "Install additional note-related key bindings.
739 See function definition for keys added."
740 (let ((map planner-mode-map))
741 (define-key map "\C-c\C-o" nil)
742 (define-key map "\C-c\C-o\C-o" 'planner-create-note)
743 (define-key map "\C-c\C-o\C-s" 'planner-search-notes)
744 (define-key map "\C-c\C-o\C-b" 'planner-search-notes-with-body)
745 (define-key map "\C-c\C-o\C-n" 'planner-renumber-notes)))
747 ;;;_* Menu
749 ;;; Menu thanks to Thomas Gehrlein
750 (easy-menu-define planner-menu planner-mode-map
751 "Menu of planner mode.
752 See `planner-install-extra-task-keybindings' for additional bindings
753 you can use."
754 (list
755 "Planner"
756 ;; moving between day plan pages
757 (if planner-use-day-pages
758 '("Goto"
759 ["Plan page" planner-goto-plan-page]
760 ["Date" planner-goto]
761 ["Previous page" planner-goto-previous-daily-page]
762 ["Next page" planner-goto-next-daily-page]
763 ["Today" planner-goto-today]
764 ;; do the next two make sense in a menu?
765 ["Yesterday" planner-goto-yesterday]
766 ["Tomorrow" planner-goto-tomorrow]
767 ["Most recent" planner-goto-most-recent])
768 '["Goto plan page" planner-goto-plan-page])
769 ;; handling tasks
770 '("Tasks"
771 ["Create" planner-create-task-from-buffer]
772 ["Create from note" planner-create-task-from-note]
773 ["Delete" planner-delete-task]
774 ["Update" planner-update-task]
775 ["Copy or move task" planner-copy-or-move-task]
776 ["Copy or move region" planner-copy-or-move-region]
777 "---"
778 ;; Roughly arranged by frequency, not by chronological sequence
779 ["Mark \"done\"" planner-task-done]
780 ["Mark \"delegated\"" planner-task-delegated]
781 ["Mark \"pending\"" planner-task-pending]
782 ["Mark \"in progress\"" planner-task-in-progress]
783 ["Mark \"cancelled\"" planner-task-cancelled]
784 ["Mark \"open\"" planner-task-open]
785 "---"
786 ["Raise task priority" planner-raise-task-priority]
787 ["Lower task priority" planner-lower-task-priority]
788 ["Format tasks nicely" planner-fix-tasks])
789 ;; notes
790 '("Notes"
791 ["Create" planner-create-note]
792 ["Create from task" planner-create-note-from-task]
793 "---"
794 ["Search" planner-search-notes]
795 ["Search with body" planner-search-notes-with-body]
796 ["Renumber" planner-renumber-notes])
797 "---"
798 ;; miscellaneous
799 '["Plan" plan]
800 "---"
801 ;; help/info (now that we have a manual, use it)
802 '["Info manual" (info "planner-el")]))
804 ;;;_* Internal functions
806 ;;;_ + Compatibility
808 ;;;_ + Emacs vs XEmacs
810 (eval-and-compile
811 (defun planner-derived-mode-p (&rest modes)
812 "Non-nil if the current major mode is derived from one of MODES.
813 Uses the `derived-mode-parent' property of the symbol to trace backwards."
814 (if (fboundp 'derived-mode-p)
815 (apply 'derived-mode-p modes)
816 ;; PUBLIC: find if the current mode derives from another.
817 ;; Taken from GNU Emacs 21 subr.el
818 (let ((parent major-mode))
819 (while (and (not (memq parent modes))
820 (setq parent (get parent 'derived-mode-parent))))
821 parent))))
823 (defalias 'planner-match-string-no-properties 'muse-match-string-no-properties)
824 (defalias 'planner-replace-regexp-in-string 'muse-replace-regexp-in-string)
825 (defalias 'planner-line-beginning-position 'muse-line-beginning-position)
826 (defalias 'planner-line-end-position 'muse-line-end-position)
828 ;;; Handling diary renaming that was official as of 23.1
829 ;;; Drop this when 23 is the oldest we support.
830 (when (< emacs-major-version 23)
831 (defalias 'diary-list-entries 'list-diary-entries)
832 (defalias 'diary-list-entries-hook 'list-diary-entries-hook)
833 (defalias 'diary-include-other-diary-files 'include-other-diary-files))
835 ;;; Copied from subr.el
836 (defun planner-copy-overlay (o)
837 "Return a copy of overlay O."
838 (if (fboundp 'copy-overlay)
839 (copy-overlay o)
840 (let ((o1 (make-overlay (overlay-start o) (overlay-end o)
841 ;; FIXME: there's no easy way to find the
842 ;; insertion-type of the two markers.
843 (overlay-buffer o)))
844 (props (overlay-properties o)))
845 (while props
846 (overlay-put o1 (pop props) (pop props)))
847 o1)))
849 ;;; Copied from subr.el
850 (defun planner-remove-overlays (beg end name val)
851 "Clear BEG and END of overlays whose property NAME has value VAL.
852 Overlays might be moved and or split."
853 (if (fboundp 'remove-overlays)
854 (remove-overlays beg end name val)
855 (if (< end beg)
856 (setq beg (prog1 end (setq end beg))))
857 (save-excursion
858 (dolist (o (overlays-in beg end))
859 (when (eq (overlay-get o name) val)
860 ;; Either push this overlay outside beg...end
861 ;; or split it to exclude beg...end
862 ;; or delete it entirely (if it is contained in beg...end).
863 (if (< (overlay-start o) beg)
864 (if (> (overlay-end o) end)
865 (progn
866 (move-overlay (planner-copy-overlay o)
867 (overlay-start o) beg)
868 (move-overlay o end (overlay-end o)))
869 (move-overlay o (overlay-start o) beg))
870 (if (> (overlay-end o) end)
871 (move-overlay o end (overlay-end o))
872 (delete-overlay o))))))))
874 ;; Provide a simpler replacement for `remove-if-not'
875 (defun planner-remove-if-not (predicate seq)
876 "Remove all items not satisfying PREDICATE in SEQ.
877 This is a non-destructive function; it makes a copy of SEQ to
878 avoid corrupting the original SEQ."
879 (let (newseq)
880 (dolist (el seq)
881 (when (funcall predicate el)
882 (setq newseq (cons el newseq))))
883 (nreverse newseq)))
885 ;; Display a warning
886 (defun planner-display-warning (message)
887 "Display the given MESSAGE as a warning."
888 (if (fboundp 'display-warning)
889 (display-warning 'planner message
890 (if (featurep 'xemacs)
891 'warning
892 :warning))
893 (let ((buf (get-buffer-create "*Planner warnings*")))
894 (with-current-buffer buf
895 (goto-char (point-max))
896 (insert "Warning (planner): " message)
897 (unless (bolp)
898 (newline)))
899 (display-buffer buf)
900 (sit-for 0))))
902 (defun planner-unhighlight-region (begin end &optional verbose)
903 "Remove all visual highlights in the buffer (except font-lock)."
904 (planner-zap-overlays begin end)
905 (muse-unhighlight-region begin end verbose))
907 (defun planner-zap-overlays (beg end &optional verbose)
908 "Remove all the planner-related overlays/extents from BEG to END."
909 (if (featurep 'xemacs)
910 (mapcar-extents 'delete-extent nil nil beg end nil 'planner t)
911 (planner-remove-overlays beg end 'planner t)))
913 (defmacro with-planner (&rest body)
914 "Make sure BODY is evaluated in a `planner-mode' buffer."
915 `(if (planner-derived-mode-p 'planner-mode)
916 (progn ,@body)
917 (with-temp-buffer
918 (setq muse-current-project (muse-project planner-project))
919 (muse-project-set-variables)
920 (planner-mode)
921 ,@body)))
922 (put 'with-planner 'lisp-indent-function 0)
923 (put 'with-planner 'edebug-form-spec '(body))
925 ;; Use a macro for the setup around planner-update-task so
926 ;; the same setup can be used in planner-multi.el
927 (defmacro with-planner-update-setup (&rest body)
928 "Execute BODY then save buffers according to `planner-tasks-file-behavior'.
929 Also sets some variables to modify font-lock behaviour while updating."
930 (let ((live-buffers (make-symbol "live-buffers")))
931 `(save-window-excursion
932 (save-excursion
933 (save-restriction
934 (let ((,live-buffers (and (eq planner-tasks-file-behavior
935 'close)
936 (buffer-list)))
937 (current-buffer (current-buffer)))
938 (prog1
939 (let ((planner-tasks-file-behavior nil))
940 ,@body)
941 (when planner-tasks-file-behavior
942 (planner-save-buffers ,live-buffers t current-buffer)))))))))
944 ;; Manually expanded def-edebug-spec so that we don't have to pull
945 ;; edebug in
946 (put 'with-planner-update-setup 'edebug-form-spec '(body))
948 (defalias 'planner-current-file 'muse-current-file)
950 (defun planner-file-alist (&optional no-check-p pages)
951 "Return possible Wiki filenames in `planner-project'.
952 On UNIX, this list is only updated if one of the directories'
953 contents have changed or NO-CHECK-P is non-nil. On Windows, it is
954 always reread from disk.
955 PAGES is ignored."
956 (muse-project-file-alist planner-project no-check-p))
958 (defun planner-find-file (wiki &optional command directory)
959 "Open the Planner page WIKI by name.
960 If COMMAND is non-nil, it is the function used to visit the file.
961 If DIRECTORY is non-nil, it is the directory in which the Wiki
962 page will be created if it does not already exist."
963 (muse-project-find-file (planner-link-base wiki)
964 planner-project
965 command
966 directory))
968 (defalias 'planner-page-name 'muse-page-name)
970 (defun planner-link-base (link)
971 "Return the page or URL named by LINK."
972 (when (string-match muse-explicit-link-regexp link)
973 (setq link (planner-match-string-no-properties 1 link)))
974 (when (string-match "#" link)
975 (setq link (substring link 0 (match-beginning 0))))
976 link)
978 (defalias 'planner-time-less-p 'muse-time-less-p)
979 (defalias 'planner-private-p 'muse-project-private-p)
980 (defalias 'planner-follow-name-at-point 'muse-follow-name-at-point)
981 (defalias 'planner-next-reference 'muse-next-reference)
982 (defalias 'planner-previous-reference 'muse-previous-reference)
984 ;; FIXME: Code that uses `planner-directory' should be changed to deal
985 ;; with multiple directories.
986 (defun planner-directory ()
987 (car (cadr (muse-project planner-project))))
989 (defun planner-published-file (file &optional output-dir style)
990 (unless output-dir
991 (setq output-dir (and muse-publishing-current-output-path
992 (file-name-directory
993 muse-publishing-current-output-path))))
994 (when output-dir
995 (muse-publish-output-file file output-dir style)))
997 (defun planner-remove-links (description)
998 "Remove explicit links from DESCRIPTION."
999 (let (start)
1000 (while (setq start (string-match muse-explicit-link-regexp description
1001 start))
1002 (setq description
1003 (replace-match (or (match-string 2 description)
1004 (match-string 1 description))
1005 t t description)))
1006 description))
1008 (defun planner-make-link (link &optional name single)
1009 "Return a Wiki link to LINK with NAME as the text.
1010 If SINGLE is non-nil, treat it as a single link.
1011 If LINK is already a valid link, replace it's description
1012 by NAME"
1013 (cond ((or (null link) (string= link ""))
1015 ((string-match muse-explicit-link-regexp link)
1016 (muse-make-link (match-string 1 link) name))
1018 (muse-make-link link name))))
1020 ;;;_ + Diary
1022 ;; In here instead of planner-diary because planner-appt and
1023 ;; planner-cyclic use it as well. Contributions from Sergey Vlasov.
1024 (defun planner-list-diary-entries (file date &optional number)
1025 "Get list of diary entries in FILE for NUMBER days starting with DATE.
1026 The list has the same form as returned by `list-diary-entries', but
1027 this function tries to undo the changes which `list-diary-entries'
1028 does to the diary buffer."
1029 (require 'diary-lib)
1030 ;; The code to restore the buffer was copied from `include-other-diary-files'
1031 (save-window-excursion
1032 (save-excursion
1033 (let* ((diary-file file)
1034 (diary-list-entries-hook '(diary-include-other-diary-files))
1035 (diary-display-hook 'ignore)
1036 (diary-hook nil)
1037 (d-buffer (find-buffer-visiting diary-file))
1038 (diary-modified (when d-buffer
1039 (set-buffer d-buffer)
1040 (buffer-modified-p))))
1041 (unwind-protect
1042 (diary-list-entries date (or number 1))
1043 (let ((d-buffer (find-buffer-visiting diary-file)))
1044 (when d-buffer
1045 (set-buffer d-buffer)
1046 (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
1047 (setq selective-display nil)
1048 (set-buffer-modified-p diary-modified))))))))
1050 ;;;_ + Mode
1052 (defcustom planner-align-tasks-automatically t
1053 "Non-nil means align tasks whenever a planner file is saved."
1054 :type 'boolean
1055 :group 'planner)
1056 (defcustom planner-sort-tasks-automatically t
1057 "Non-nil means sort tasks whenever a planner file is saved."
1058 :type 'boolean
1059 :group 'planner)
1060 (defcustom planner-renumber-tasks-automatically nil
1061 "Non-nil means renumber tasks whenever a planner file is saved."
1062 :type 'boolean
1063 :group 'planner)
1064 (defcustom planner-renumber-notes-automatically nil
1065 "Non-nil means renumber notes whenever a planner file is saved."
1066 :type 'boolean
1067 :group 'planner)
1069 ;;;###autoload
1071 (define-derived-mode planner-mode muse-mode "Planner"
1072 "A personal information manager for Emacs.
1073 \\{planner-mode-map}"
1074 ;; because we're not inheriting from normal-mode, we need to
1075 ;; explicitly run file variables if the user wants to
1076 (condition-case err
1077 (hack-local-variables)
1078 (error (message "File local-variables error: %s"
1079 (prin1-to-string err))))
1080 ;; check to see if the mode changed
1081 (when (eq major-mode 'planner-mode)
1082 (let ((hook (if (boundp 'write-file-functions)
1083 'write-file-functions
1084 'write-file-hooks)))
1085 (add-hook hook 'planner-renumber-notes-maybe t t)
1086 (add-hook hook 'planner-sort-tasks-maybe t t)
1087 (add-hook hook 'planner-renumber-tasks-maybe t t)
1088 (add-hook hook 'planner-align-tasks-maybe t t))
1089 (planner-setup-highlighting)
1090 (when (fboundp 'easy-menu-add)
1091 (easy-menu-add planner-menu planner-mode-map))
1092 (planner-prepare-file)))
1093 ;; (when (and font-lock-mode muse-mode-highlight-p)
1094 ;; (muse-colors-buffer))))
1096 (defvar planner-date-regexp
1097 "\\<\\([1-9][0-9][0-9][0-9]\\)[\\.\\-]\\([0-9]+\\)[\\.\\-]\\([0-9]+\\)\\>")
1099 (defun planner-setup-highlighting ()
1100 "Set up fontification for planner."
1101 (add-hook 'muse-colors-buffer-hook 'planner-zap-overlays t t)
1102 (add-hook 'muse-colors-buffer-hook 'planner-highlight-tasks t t)
1103 (add-hook 'muse-colors-buffer-hook 'planner-highlight-notes t t)
1104 (add-to-list 'muse-colors-markup
1105 (list planner-date-regexp t 'muse-colors-implicit-link)
1107 (muse-configure-highlighting 'muse-colors-markup muse-colors-markup)
1108 (set (make-local-variable 'font-lock-unfontify-region-function)
1109 'planner-unhighlight-region)
1110 (set (make-local-variable 'font-lock-defaults)
1111 '(nil t nil nil beginning-of-line
1112 (font-lock-fontify-region-function . muse-colors-region)
1113 (font-lock-unfontify-region-function
1114 . planner-unhighlight-region))))
1116 (defun planner-muse-handle-date-link (&optional string)
1117 "If STRING or point has a date, match and return it."
1118 (when (if string
1119 (string-match planner-date-regexp string)
1120 (looking-at planner-date-regexp))
1121 (match-string 0 string)))
1123 (custom-add-option 'muse-implicit-link-functions
1124 'planner-muse-handle-date-link)
1125 (add-hook 'muse-implicit-link-functions 'planner-muse-handle-date-link t)
1127 ;;;_ + Wiki pages
1129 (defun planner-strip-whitespace (string)
1130 "Remove all whitespace from STRING. Return the modified string."
1131 (with-temp-buffer
1132 (insert string)
1133 (goto-char (point-min))
1134 (while (re-search-forward "[\r\n\t ]+" nil t)
1135 (replace-match ""))
1136 (buffer-string)))
1138 (defun planner-page-default-p (&optional buffer)
1139 "Return t if this plan page can be safely deleted.
1140 If the contents of this plan page are the same as the value of
1141 `planner-day-page-template' or the plan page is empty, then no
1142 information has been added and the page can safely be removed.
1144 If BUFFER is given, considers the planner page in BUFFER instead.
1146 Override this if `planner-day-page-template' is a function
1147 instead of a string."
1148 (with-current-buffer (or buffer (current-buffer))
1149 (when (and (stringp planner-day-page-template)
1150 (not (> (buffer-size)
1151 (+ (length planner-day-page-template)
1152 planner-template-fuzz-factor))))
1153 (let ((body (planner-strip-whitespace (buffer-string))))
1154 (or (= (length body) 0)
1155 (string= body (planner-strip-whitespace
1156 planner-day-page-template)))))))
1158 (defvar planner-delete-file-function 'delete-file
1159 "Function called to remove a planner file from the current wiki.")
1161 (defun planner-maybe-remove-file ()
1162 "Delete the planner file if it does not contain new information."
1163 (if (planner-page-default-p (current-buffer))
1164 (let ((filename buffer-file-name))
1165 (set-buffer-modified-p nil)
1166 (kill-buffer (current-buffer))
1167 (when (file-exists-p filename)
1168 (funcall planner-delete-file-function filename)))
1169 (kill-buffer (current-buffer))))
1172 (defun planner-prepare-file ()
1173 "Insert some standard sections into an empty planner file."
1174 (when (= (buffer-size) 0)
1175 (let ((template
1176 (if (and (planner-page-name)
1177 (string-match planner-date-regexp (planner-page-name)))
1178 planner-day-page-template
1179 planner-plan-page-template)))
1180 (if (functionp template)
1181 (funcall template)
1182 (insert template))
1183 (set-buffer-modified-p nil))))
1185 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1186 ;; Compatibility
1188 (defun planner-link-href (url name)
1189 "Return an href string for URL and NAME."
1190 (muse-publish-url url name))
1192 (defun planner-link-target (link)
1193 "Return the URL or page in LINK."
1194 (if (string-match muse-explicit-link-regexp link)
1195 (planner-match-string-no-properties 1 link)
1196 link))
1198 (defun planner-link-name (link)
1199 "Return the name for LINK."
1200 (if (string-match muse-explicit-link-regexp link)
1201 (planner-match-string-no-properties 2 link)
1202 link))
1204 (defun planner-link-anchor (link)
1205 "Return the anchor part of LINK."
1206 (setq link (planner-link-target link))
1207 (if (string-match "#" link)
1208 (substring link (1+ (match-beginning 0)))))
1210 (defun planner-visit-link (link &optional other-window)
1211 "Visit the URL or link named by LINK.
1212 REFRESH-BUFFER is an optional buffer to refresh on saving the visited page.
1213 This makes the bad link face in the linking buffer go away."
1214 (if (string-match muse-url-regexp link)
1215 (muse-browse-url link other-window)
1216 (setq link (planner-link-target link))
1217 (let ((tag (planner-link-anchor link))
1218 base-buffer)
1219 ;; use match data from planner-link-anchor
1220 (when tag
1221 (setq link (if (= (match-beginning 0) 0)
1222 ;; If there is an anchor but no link, default
1223 ;; to the current page.
1225 (substring link 0 (match-beginning 0)))))
1226 (when link
1227 (setq base-buffer (get-buffer link))
1228 (if (and base-buffer (not (buffer-file-name base-buffer)))
1229 ;; If file is temporary (no associated file), just switch to
1230 ;; the buffer
1231 (if other-window
1232 (switch-to-buffer-other-window base-buffer)
1233 (switch-to-buffer base-buffer))
1234 (let ((project (muse-project-of-file)))
1235 (if project
1236 (muse-project-find-file link project
1237 (and other-window
1238 'find-file-other-window))
1239 (if other-window
1240 (find-file-other-window link)
1241 (find-file link))))))
1242 (when tag
1243 (goto-char (point-min))
1244 (or (re-search-forward (concat "^\\.?#" (regexp-quote tag) "\\>")
1245 nil t)
1246 (when (string-match "^anchor-\\(.*\\)" tag)
1247 (re-search-forward
1248 (concat "^\\.?#" (regexp-quote (match-string 1 tag)) "\\>")
1249 nil t)))))))
1251 (defalias 'planner-add-protocol 'muse-protocol-add)
1252 (defalias 'planner-page-exists-p 'planner-page-file)
1254 (defun planner-local-page-p (link)
1255 "Return non-nil if LINK seems to belong to the current wiki."
1256 (and link
1257 (not (or (string-match ":\\|/"
1258 (planner-link-base link))))))
1260 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1261 (defun planner-list-daily-files (&optional exclude-temp)
1262 "Return an unsorted, unique list of daily files.
1263 If EXCLUDE-TEMP is non-nil, ignore unsaved buffers."
1264 ;; get a list of all files
1265 ;; (save-some-buffers t (lambda () (equal 'planner-mode major-mode)))
1266 (let ((buffers (buffer-list))
1267 files)
1268 (mapcar (lambda (item)
1269 (when (string-match planner-date-regexp (car item))
1270 (unless (rassoc (cdr item) files)
1271 (setq files (cons item files)))))
1272 (planner-file-alist))
1273 (unless exclude-temp
1274 (while buffers
1275 (with-current-buffer (car buffers)
1276 (when (and (equal 'planner-mode major-mode)
1277 (planner-page-name)
1278 (string-match planner-date-regexp (planner-page-name)))
1279 (unless (assoc (planner-page-name) files)
1280 (add-to-list 'files (cons (planner-page-name)
1281 (buffer-file-name))))))
1282 (setq buffers (cdr buffers))))
1283 files))
1285 (defun planner-get-day-pages (&optional from to exclude-temp)
1286 "Return a descending list of day pages from FROM to TO (inclusive).
1287 If EXCLUDE-TEMP is non-nil, ignore unsaved pages."
1288 (sort (delq nil
1289 (mapcar
1290 (lambda (item)
1291 (and
1292 (car item)
1293 (or (not from)
1294 (string-lessp from (car item))
1295 (equal from (car item)))
1296 (or (not to)
1297 (string-lessp (car item) to)
1298 (equal (car item) to))
1299 item))
1300 (planner-list-daily-files exclude-temp)))
1301 (lambda (l r)
1302 (string-lessp (car r) (car l)))))
1304 ;;;_ + Date
1306 (defvar planner-calendar-selected-date nil
1307 "Temporary storage for date selected from calendar.")
1309 (defvar planner-use-calendar-flag t
1310 "*If non-nil, show calendar popup when reading a date.")
1312 (defun planner-read-date (&optional prompt force-read)
1313 "Prompt for a date string in the minibuffer.
1314 If PROMPT is non-nil, display it as the prompt string.
1315 If FORCE-READ is non-nil, prompt for a date even when we are not
1316 using day pages."
1317 (save-window-excursion
1318 (when (or planner-use-day-pages force-read)
1319 (let ((old-buffer (current-buffer)))
1320 (when planner-use-calendar-flag (calendar))
1321 (let ((old-map (copy-keymap calendar-mode-map)))
1322 (unwind-protect
1323 (progn
1324 (define-key calendar-mode-map [return]
1325 'planner-calendar-select)
1326 (define-key calendar-mode-map [mouse-1]
1327 'planner-calendar-select)
1328 (setq planner-calendar-selected-date nil)
1329 (let ((text (read-string
1330 (format "%s %s"
1331 (or prompt "When")
1332 (format-time-string
1333 (concat "(%Y" planner-date-separator "%m"
1334 planner-date-separator "%d, %m"
1335 planner-date-separator "%d, %d): "))))))
1336 (or planner-calendar-selected-date
1337 (with-current-buffer old-buffer
1338 (planner-expand-name text)))))
1339 (setq calendar-mode-map old-map)))))))
1341 (defvar planner-timewarp-date nil
1342 "*Date to timewarp to for planner.
1343 Should be a string of the form YYYY.MM.DD. If nil, do not timewarp.")
1345 ;; This should be handy for remembering lots of notes onto particular days.
1346 (defun planner-timewarp (date)
1347 "Timewarp to DATE."
1348 (interactive (list (let ((planner-timewarp-date nil)) (planner-read-date))))
1349 (setq planner-timewarp-date date)
1350 (if date (message "Timewarped to %s" date)
1351 (message "Timewarped back to the present")))
1353 (defun planner-today ()
1354 "Return the filename of the current date."
1355 (if planner-use-day-pages
1356 (or planner-timewarp-date (planner-date-to-filename
1357 (decode-time (current-time))))
1358 planner-initial-page))
1360 (defun planner-date-to-filename (date)
1361 "Return the planner filename corresponding to DATE.
1362 DATE is a list (month day year) or an internal date representation."
1363 (let ( (date-form-string (concat "%04d" planner-date-separator "%02d"
1364 planner-date-separator "%02d") ) )
1365 (progn
1366 (if (= (length date) 3)
1367 (format date-form-string (elt date 2) (elt date 0) (elt date 1))
1368 (if (= (length date) 2)
1369 (setq date (decode-time date)))
1370 (format date-form-string
1371 (elt date 5) ; year
1372 (elt date 4) ; month
1373 (elt date 3)))))) ; day
1375 (defun planner-calculate-date-from-day-offset (origin offset)
1376 "From ORIGIN, calculate the date OFFSET days into the past or future.
1377 ORIGIN can be a buffer name, a list of the form (MONTH DAY YEAR),
1378 or an internal date representation. If OFFSET is positive,
1379 returns a date in the future. If OFFSET is negative, returns the
1380 date -OFFSET days in the past. Return an object that is the
1381 same type as ORIGIN."
1382 (cond
1383 ((stringp origin)
1384 (let ((date (planner-filename-to-calendar-date origin)))
1385 (planner-date-to-filename (encode-time 0 0 0 (+ (elt date 1) offset)
1386 (elt date 0) (elt date 2)))))
1387 ((= (length origin) 2)
1388 (encode-time 0 0 0 (+ (elt origin 1) offset)
1389 (elt origin 0) (elt origin 2)))
1390 ((= (length origin) 3)
1391 (let ((result
1392 (decode-time (encode-time 0 0 0 (+ (elt origin 1) offset)
1393 (elt origin 0) (elt origin 2)))))
1394 (list (elt result 4) (elt result 3) (elt result 5))))))
1396 (defun planner-get-previous-existing-day (date)
1397 "Return the planner file immediately before DATE.
1398 DATE is a filename or a list (month day year). When called from
1399 a planner file, DATE defaults to the date of this file, otherwise
1400 it defaults to today. Returns an object of the same type as
1401 DATE."
1402 (let ((newdate (if (listp date) (planner-date-to-filename date) date))
1403 (result nil))
1404 ;; beginning of hackish part
1405 (mapcar (lambda (elt)
1406 (when (and (or (not result)
1407 (not (or (string= elt result)
1408 (string< elt result))))
1409 (string< elt newdate))
1410 (setq result elt)))
1411 (mapcar 'car (planner-list-daily-files)))
1412 (if result
1413 (if (listp date)
1414 (planner-filename-to-calendar-date result)
1415 result)
1416 (error "No previous planner file"))))
1418 (defun planner-get-next-existing-day (date)
1419 "Return the existing planner file immediately after DATE.
1420 DATE is a filename or a list (month day year). When called from
1421 a planner file, DATE defaults to the date of this file, otherwise
1422 it defaults to today. Returns an object of the same type as
1423 DATE."
1424 (let ((newdate (if (listp date) (planner-date-to-filename date) date))
1425 (result nil))
1426 ;; beginning of hackish part
1427 (mapcar (lambda (elt)
1428 (when (and (or (not result)
1429 (string< elt result))
1430 (not (or (string= elt newdate)
1431 (string< elt newdate))))
1432 (setq result elt)))
1433 (mapcar 'car (planner-list-daily-files)))
1434 (if result
1435 (if (listp date)
1436 (planner-filename-to-calendar-date result)
1437 result)
1438 (error "No next planner file"))))
1440 (defun planner-yesterday ()
1441 "Return the date of yesterday."
1442 (planner-calculate-date-from-day-offset (planner-today) -1))
1444 (defun planner-tomorrow ()
1445 "Return the date of tomorrow."
1446 (planner-calculate-date-from-day-offset (planner-today) 1))
1448 (defcustom planner-expand-name-favor-future-p nil
1449 "If non-nil, `planner-expand-name' defaults to future dates."
1450 :type 'boolean
1451 :group 'planner)
1453 (defcustom planner-expand-name-default "."
1454 "What an empty string means in `planner-expand-name'.
1455 \".\" means today."
1456 :type '(choice
1457 (const :tag "Today" ".")
1458 (const :tag "None" nil)
1459 string)
1460 :group 'planner)
1462 (defvar planner-expand-name-days-alist '(("sun" . 0)
1463 ("mon" . 1)
1464 ("tue" . 2)
1465 ("wed" . 3)
1466 ("thu" . 4)
1467 ("fri" . 5)
1468 ("sat" . 6))
1469 "Abbreviations for `planner-expand-name'.")
1471 (defun planner-expand-name (name)
1472 "Expand the given NAME to its fullest form.
1473 This typically means that dates like 3.31 will become 2001.03.31.
1474 NOTE: This function no longer uses the current buffer filename for
1475 defaults."
1476 (let ((now (if planner-use-day-pages
1477 (planner-filename-to-calendar-date (planner-today))
1478 (planner-filename-to-calendar-date
1479 (planner-date-to-filename
1480 (decode-time (current-time))))))
1481 name-year name-month name-day)
1482 (when (string-match "^\\s-*$" name)
1483 (setq name (or planner-expand-name-default "nil")))
1484 (cond
1485 ((string= "nil" name) nil)
1486 ((string= "." name) (if (not planner-use-day-pages)
1487 (planner-date-to-filename now)
1488 (planner-today)))
1489 ((string-match (concat "^\\([1-9][0-9][0-9][0-9][\\.\\-]\\)?"
1490 "\\(\\([0-9]+\\)[\\.\\-]\\)?"
1491 "\\([0-9]+\\)\\(#.*\\)?$") name)
1492 (setq name-year
1493 (if (match-string 1 name)
1494 (string-to-number (match-string 1 name)) (nth 2 now)))
1495 (setq name-month
1496 (if (match-string 3 name)
1497 (string-to-number (match-string 3 name)) (nth 0 now)))
1498 (setq name-day
1499 (if (match-string 4 name)
1500 (string-to-number (match-string 4 name)) (nth 1 now)))
1501 (when (and planner-expand-name-favor-future-p
1502 (planner-time-less-p
1503 (encode-time 59 59 23
1504 name-day name-month name-year)
1505 (current-time)))
1506 (cond
1507 ((match-string 1 name)) ; Do nothing if the year is specified
1508 ((match-string 2 name)
1509 (setq name-year (1+ name-year)))
1510 ((match-string 4 name)
1511 (setq name-month (1+ name-month)))))
1512 (planner-date-to-filename (encode-time 59 59 23
1513 name-day name-month name-year)))
1514 ((string-match "^\\([-+]\\)\\s-*\\([0-9]+\\)$" name)
1515 ;; Today + or - that number of days
1516 (planner-calculate-date-from-day-offset
1517 (if (not planner-use-day-pages)
1518 (planner-date-to-filename now)
1519 (if (or planner-dates-relative-to-today-flag
1520 (not (planner-page-name))
1521 (not (save-match-data
1522 (string-match planner-date-regexp
1523 (planner-page-name)))))
1524 (planner-today)
1525 (planner-page-name)))
1526 (string-to-number
1527 (concat (match-string 1 name) (match-string 2 name)))))
1528 ((let ((case-fold-search nil))
1529 (string-match (concat
1530 "^\\([-+]\\)\\s-*\\([0-9]*\\)\\s-*\\("
1531 (mapconcat 'car planner-expand-name-days-alist "\\|")
1532 "\\)\\s-*\\([\\.\\-]\\|\\(\\(\\([0-9]+[\\.\\-]\\)?[0-9]+[\\-\\.]\\)?[0-9]+\\)\\)?$")
1533 name))
1534 (let* ((day (cdr (assoc (match-string 3 name)
1535 planner-expand-name-days-alist)))
1536 (offset (string-to-number
1537 (concat (match-string 1 name)
1538 (if (and
1539 (match-string 2 name)
1540 (not (string= (match-string 2 name) "")))
1541 (match-string 2 name)
1542 "1"))))
1543 (base-date (planner-filename-to-calendar-date
1544 (if (and (match-string 4 name)
1545 (not (string= (match-string 4 name) "")))
1546 (planner-expand-name (match-string 4 name))
1547 (if (not planner-use-day-pages)
1548 (planner-date-to-filename now)
1549 (if (or planner-dates-relative-to-today-flag
1550 (not (planner-page-name))
1551 (not (save-match-data
1552 (string-match
1553 planner-date-regexp
1554 (planner-page-name)))))
1555 (planner-today)
1556 (planner-page-name)))))))
1557 (planner-date-to-filename
1558 (calendar-gregorian-from-absolute
1559 (calendar-dayname-on-or-before
1561 (+ (calendar-absolute-from-gregorian base-date)
1562 (* offset 7)
1563 (if (< offset 0) 6 0)))))))
1564 (t name))))
1566 (defun planner-get-current-date-filename ()
1567 "Return the date of the daily page currently being viewed.
1568 If no daily page is being viewed, return today's date."
1569 (if (string-match planner-date-regexp (planner-page-name))
1570 (planner-page-name)
1571 (planner-today)))
1573 (defun planner-filename-to-calendar-date (filename)
1574 "Return the date of the planning file FILENAME.
1575 Date is a list (month day year)."
1576 (unless (string-match planner-date-regexp filename)
1577 (error "Not convertible to a date %s" filename))
1578 (list (string-to-number (match-string 2 filename)) ; month
1579 (string-to-number (match-string 3 filename)) ; day
1580 (string-to-number (match-string 1 filename)))) ; year
1582 ;;;_ + Sections
1584 (defun planner-narrow-to-section (section &optional create)
1585 "Widen to the whole page and narrow to the section labelled SECTION.
1586 If CREATE is non-nil, create the section if it is not found.
1587 Return non-nil if SECTION was found."
1588 (interactive "MSection: ")
1589 (widen)
1590 (unless (stringp section)
1591 (setq section (cdr (assoc section planner-sections))))
1592 (goto-char (point-min))
1593 (when (or
1594 (re-search-forward
1595 (concat "^*\\s-+" (regexp-quote section) "\\s-*$") nil t)
1596 (and create
1597 (funcall planner-create-section-function section)
1598 (goto-char (point-min))
1599 (re-search-forward (concat "^*\\s-+" (regexp-quote section)
1600 "\\s-*$") nil t)))
1601 (let ((beg (match-beginning 0))
1602 (end (if (re-search-forward "^*\\s-+" nil t)
1603 (match-beginning 0) (point-max))))
1604 (narrow-to-region beg end)
1605 t)))
1607 (defun planner-delete-section (section)
1608 "Delete the named SECTION."
1609 (unless (planner-derived-mode-p 'planner-mode)
1610 (error "This is not a planner buffer"))
1611 (unless (stringp section)
1612 (setq section (cdr (assoc section planner-sections))))
1613 (widen)
1614 (goto-char (point-min))
1615 (when (re-search-forward (concat "^\\*\\s-+" section "\\(\\s-*\\)$") nil t)
1616 (let ((beg (planner-line-beginning-position))
1617 (end (if (re-search-forward "^* " nil t)
1618 (planner-line-beginning-position)
1619 (point-max))))
1620 (delete-region beg end))))
1622 (defun planner-delete-section-text (section)
1623 "Delete the text of the named SECTION."
1624 (unless (planner-derived-mode-p 'planner-mode)
1625 (error "This is not a planner buffer"))
1626 (unless (stringp section)
1627 (setq section (cdr (assoc section planner-sections))))
1628 (widen)
1629 (goto-char (point-min))
1630 (when (re-search-forward (concat "^\\*\\s-+" section "\\(\\s-*\\)$") nil t)
1631 (let ((beg (point))
1632 (end (if (re-search-forward "^* " nil t)
1633 (planner-line-beginning-position)
1634 (point-max))))
1635 (delete-region beg end)
1636 (goto-char (planner-line-beginning-position)))))
1638 (defun planner-seek-to-first (&optional section)
1639 "Positions the point at the specified SECTION, or Tasks if not specified."
1640 (interactive)
1641 (unless section
1642 (setq section planner-default-section))
1643 (unless (stringp section)
1644 (setq section (cdr (assoc section planner-sections))))
1645 (widen)
1646 (goto-char (point-min))
1647 (if (re-search-forward (concat "^\\*\\s-+" section "\\(\\s-*?\\)$") nil t)
1648 (let ((old (point)) new)
1649 (forward-line 1)
1650 (if (re-search-forward "[^\\s-]" nil t)
1651 (progn
1652 (goto-char (planner-line-beginning-position))
1653 (unless (looking-at "^\\*\\s-")
1654 (setq new (point)))))
1655 (goto-char (or new old))
1656 (unless new
1657 (forward-line 1)
1658 (when (or (looking-at "^\\*\\s-+")
1659 (> (forward-line 1) 0)) (insert "\n"))
1660 (when (or (looking-at "^\\*\\s-+")
1661 (> (forward-line 1) 0)) (insert "\n"))
1662 (when (looking-at "^\\*\\s-+") (forward-line -1))))
1663 ;; Section not found, so create it.
1664 (funcall planner-create-section-function section)))
1666 (defun planner-create-at-top (section)
1667 "Create SECTION at top of file."
1668 (goto-char (point-min))
1669 (let ((buffer-status (buffer-modified-p)))
1670 (insert "* " section "\n\n")
1671 (set-buffer-modified-p buffer-status)))
1673 (defun planner-create-at-bottom (section)
1674 "Create SECTION at bottom of file."
1675 (goto-char (point-max))
1676 (let ((buffer-status (buffer-modified-p)))
1677 (insert "\n* " section "\n\n")
1678 (set-buffer-modified-p buffer-status)))
1680 ;;;_ + Basic annotation
1682 ;;;###autoload
1683 (defun planner-annotation-as-kill (arg)
1684 "Copy the current annotation into the kill ring.
1685 When called with a prefix argument, prompt for the link display name."
1686 (interactive "P")
1687 (let* ((link (run-hook-with-args-until-success
1688 'planner-annotation-functions))
1689 (link-name (if arg (read-string (format "Link name for %s: " link)))))
1690 (unless (or (not (stringp link-name)) (string= link-name ""))
1691 (setq link (planner-make-link link link-name t)))
1692 (if (not (stringp link))
1693 (message "No annotation can be made")
1694 (message "Copied '%s' to the kill-ring" link)
1695 (kill-new link))))
1696 (custom-add-option 'planner-annotation-functions
1697 'planner-annotation-as-kill)
1699 (defun planner-annotation-from-planner-note ()
1700 "Return a link to the current page.
1701 Call when the point is on the first line of the note."
1702 (when (and (planner-derived-mode-p 'planner-mode)
1703 (planner-page-name))
1704 (save-excursion
1705 (goto-char (planner-line-beginning-position))
1706 (when (looking-at ".\\(#[0-9]+\\)")
1707 (planner-make-link
1708 (concat (planner-page-name)
1709 (planner-match-string-no-properties 1))
1710 (concat (planner-page-name)
1711 (planner-match-string-no-properties 1))
1712 t)))))
1713 (custom-add-option 'planner-annotation-functions
1714 'planner-annotation-from-planner-note)
1716 (defun planner-annotation-from-planner ()
1717 "Return a wiki link to the current wiki page.
1718 Date pages are not linked."
1719 (when (and (planner-derived-mode-p 'planner-mode)
1720 (planner-page-name))
1721 (cond
1722 ((string-match planner-date-regexp (planner-page-name))
1723 "") ; None for date pages
1724 (t (planner-make-link (planner-page-name) nil t)))))
1725 (custom-add-option 'planner-annotation-functions
1726 'planner-annotation-from-planner)
1728 (defun planner-annotation-from-wiki ()
1729 "Return the interwiki link to the current wiki page."
1730 (when (and (planner-derived-mode-p 'muse-mode)
1731 muse-current-project
1732 (muse-page-name))
1733 (concat "[[" (car muse-current-project) "::" (muse-page-name) "]]")))
1734 (custom-add-option 'planner-annotation-functions
1735 'planner-annotation-from-wiki)
1737 (defun planner-annotation-from-dired ()
1738 "Return the `default-directory' of the current Dired buffer."
1739 (when (eq major-mode 'dired-mode)
1740 (planner-make-link default-directory)))
1742 (custom-add-option 'planner-annotation-functions
1743 'planner-annotation-from-dired)
1745 (defcustom planner-annotation-use-relative-file nil
1746 "If t, use relative file links always.
1747 If a function, it is called with the file name. Return value of t
1748 means use relative file links."
1749 :group 'planner
1750 :type '(choice (const :tag "Always use relative file links" t)
1751 (const :tag "Never use relative file links" nil)
1752 function))
1754 (defcustom planner-annotation-strip-directory nil
1755 "If non-nil, strip the directory part of the filename from link text."
1756 :group 'planner
1757 :type 'boolean)
1759 (defcustom planner-annotation-format-local-file-name nil
1760 "If non-nil, use the result of `planner-annotation-format-local-file-name'."
1761 :group 'planner
1762 :type '(choice (const :tag "Use filename as is" nil)
1763 function))
1765 (defun planner-annotation-from-file ()
1766 "Return the filename of the current buffer.
1767 If `planner-annotation-use-relative-file' is t or a function that
1768 returns non-nil, a relative link is used instead. If
1769 `planner-annotation-strip-directory' is non-nil, the directory is
1770 stripped from the link description."
1771 (when buffer-file-name
1772 (planner-make-link
1773 (if (or (and (functionp planner-annotation-use-relative-file)
1774 (funcall planner-annotation-use-relative-file
1775 (buffer-file-name)))
1776 (equal planner-annotation-use-relative-file t))
1777 (file-relative-name (buffer-file-name) (planner-directory))
1778 (if (functionp planner-annotation-format-local-file-name)
1779 (funcall planner-annotation-format-local-file-name buffer-file-name)
1780 buffer-file-name))
1781 (when planner-annotation-strip-directory
1782 (file-name-nondirectory buffer-file-name))
1783 t)))
1784 (custom-add-option 'planner-annotation-functions
1785 'planner-annotation-from-file)
1787 ;;;###autoload
1788 (defun planner-annotation-from-file-with-position ()
1789 "Return the filename and cursor position of the current buffer.
1790 If `planner-annotation-use-relative-file' is t or a function that
1791 returns non-nil, a relative link is used instead. If
1792 `planner-annotation-strip-directory' is non-nil, the directory is
1793 stripped from the link description."
1794 (when buffer-file-name
1795 (planner-make-link
1796 (concat
1797 "pos://"
1798 (if (or (and (functionp planner-annotation-use-relative-file)
1799 (funcall planner-annotation-use-relative-file
1800 (buffer-file-name)))
1801 (equal planner-annotation-use-relative-file t))
1802 (file-relative-name (buffer-file-name) (planner-directory))
1803 buffer-file-name)
1804 "#" (number-to-string (point)))
1805 (if planner-annotation-strip-directory
1806 (file-name-nondirectory buffer-file-name)
1807 buffer-file-name)
1808 t)))
1810 ;;;###autoload
1811 (defun planner-browse-position-url (url)
1812 "If this is a position URL, jump to it."
1813 (when (string-match "^pos://\\(.+\\)#\\([0-9]+\\)$" url)
1814 (let ((file (match-string 1 url))
1815 (pos (string-to-number (match-string 2 url))))
1816 (find-file file)
1817 (goto-char pos)
1818 t)))
1820 ;;;###autoload
1821 (defun planner-resolve-position-url (id)
1822 "Replace ID with the blog, web or e-mail address of the BBDB record."
1823 (save-match-data
1824 (when (string-match "\\`pos://\\(.+\\)#\\([0-9]+\\)" id)
1825 (match-string 1 id))))
1827 (planner-add-protocol "pos://" 'planner-browse-position-url
1828 'planner-resolve-position-url)
1829 (custom-add-option 'planner-annotation-functions
1830 'planner-annotation-from-file-with-position)
1832 ;;;_ + Tasks
1834 (defcustom planner-create-task-hook nil
1835 "Functions to run after a task has been created.
1836 Point will be on the same line as the task."
1837 :type 'hook
1838 :group 'planner-tasks)
1840 (defcustom planner-create-task-from-buffer-hook nil
1841 "Functions to run after a task has been created from a buffer.
1842 This will be run before `planner-create-task-hook'.
1843 Point will be on the same line as the task."
1844 :type 'hook
1845 :group 'planner-tasks)
1847 (defcustom planner-task-dates-favor-future-p nil
1848 "*If this is non-nil, favor future dates for task creation or movement."
1849 :type 'boolean
1850 :group 'planner-tasks)
1852 (defcustom planner-default-page "TaskPool"
1853 "Default page for tasks.
1854 This is set to the current planner page, or the last page used
1855 if not on a plan page."
1856 :type 'string
1857 :group 'planner-tasks)
1859 (defcustom planner-tasks-file-behavior 'close
1860 "Controls behavior of task creation and updates.
1861 If 'close, newly-opened files are saved and closed.
1862 If 'save, newly-opened files are saved and left open.
1863 If nil, no actions will be taken."
1864 :group 'planner-tasks
1865 :type '(choice (const :tag "Save and close opened files" 'close)
1866 (const :tag "Save opened files" 'save)
1867 (const :tag "Do nothing" nil)))
1869 (defcustom planner-tasks-never-suppress-fixing-flag t
1870 "Non-nil means always sort, renumber and align tasks whenever
1871 files are saved."
1872 :group 'planner-tasks
1873 :type 'boolean)
1875 (defcustom planner-sort-undated-tasks-equivalent "9999.99.99"
1876 "Date considered for undated tasks.
1877 This option controls task sorting on plan pages. By default,
1878 undated tasks are sorted after dated tasks."
1879 :group 'planner-tasks
1880 :type
1881 '(choice
1882 (const :tag "Sort undated tasks after dated tasks" "9999.99.99")
1883 (const :tag "Sort undated tasks before dated tasks" "")
1884 string))
1886 (defcustom planner-sort-tasks-key-function 'planner-sort-tasks-default-key
1887 "Function called to determine the sorting key for the current line."
1888 :group 'planner-tasks
1889 :type 'function)
1891 (defcustom planner-use-task-numbers nil
1892 "Non-nil means number tasks.
1893 This allows you to refer to past tasks if your tasks are numbered
1894 appropriately. If you set this to nil, you can save space in your
1895 plan files."
1896 :type 'boolean
1897 :group 'planner-tasks)
1899 ;;;_ + Information
1901 (defun planner-task-info-from-string (page-name string)
1902 "On the planner page PAGE-NAME, parse STRING and return the task as a list.
1903 Argument PAGE-NAME is used to determine whether this is a link
1904 from a plan page or a date page."
1905 (with-planner
1906 (when (string-match "#\\([A-C]\\)\\([0-9]*\\)\\s-+\\(.\\)\\s-+\\(.+\\)"
1907 string)
1908 (let ((priority (planner-match-string-no-properties 1 string))
1909 (number (planner-match-string-no-properties 2 string))
1910 (status (planner-match-string-no-properties 3 string))
1911 (description (planner-match-string-no-properties 4 string))
1912 (case-fold-search nil)
1913 link-text link plan date)
1914 (when (= (length number) 0)
1915 (setq number nil))
1916 (cond
1917 ((string-match
1918 "\\s-+(\\(\\[\\[\\([^])]+\\)\\]\\[\\([^])]+\\)\\]\\]\\))\\s-*$"
1919 description)
1920 (setq link-text (match-string 1 description))
1921 (setq link (match-string 2 description))
1922 (setq description (replace-match "" t t description)))
1923 ((string-match
1924 "\\s-+(\\(\\[\\[\\([^])]+\\)\\]\\]\\))\\s-*$" description)
1925 (setq link-text (match-string 1 description))
1926 (setq link (match-string 2 description))
1927 (setq description (replace-match "" t t description)))
1928 ((string-match "\\s-+(\\([^)]+\\))\\s-*$" description)
1929 (setq link-text (match-string 1 description))
1930 (setq link (match-string 1 description))
1931 (setq description (replace-match "" t t description)))
1932 ((string-match "\\s-+$" description)
1933 (setq description (replace-match "" t t description))))
1934 (when link
1935 (setq link (planner-link-base link-text)))
1936 (unless (planner-local-page-p link) (setq link nil))
1937 (if (string-match planner-date-regexp page-name)
1938 ;; We're on a date page, so the link page (if any) should be the
1939 ;; planner page.
1940 (progn
1941 (setq date page-name)
1942 (setq plan (and link
1943 (unless (string-match planner-date-regexp link)
1944 link))))
1945 ;; We're on a planner page, so the link page (if any) will be the plan
1946 (setq plan (and page-name (unless (string-match planner-date-regexp
1947 page-name)
1948 page-name)))
1949 (when (and link (string-match planner-date-regexp link))
1950 (setq date (match-string 0 link))))
1951 (list page-name
1952 priority number status description link link-text plan date)))))
1954 (defun planner-task-info-override (task-info properties)
1955 "Replace fields in TASK-INFO with PROPERTIES.
1956 Acceptable properties are: page-name priority number status
1957 description link link-text plan date."
1958 (let ((fields '(page-name priority number status description
1959 link link-text plan date))
1960 result)
1961 (while task-info
1962 (setq result
1963 (cons
1964 (car (let ((search (memq (car fields) properties)))
1965 (if search (cdr search) task-info)))
1966 result))
1967 (setq fields (cdr fields))
1968 (setq task-info (cdr task-info)))
1969 (nreverse result)))
1971 (defun planner-current-task-info ()
1972 "Parse the current line and return the task information as a list."
1973 (planner-task-info-from-string (planner-page-name)
1974 (buffer-substring
1975 (planner-line-beginning-position)
1976 (planner-line-end-position))))
1978 (defun planner-task-page (info)
1979 "Return the page of a task given INFO." (nth 0 info))
1980 (defun planner-task-priority (info)
1981 "Return the priority of a task given INFO." (nth 1 info))
1982 (defun planner-task-number (info)
1983 "Return the number of a task given INFO." (nth 2 info))
1984 (defun planner-task-status (info)
1985 "Return the status of a task given INFO." (nth 3 info))
1986 (defun planner-task-description (info)
1987 "Return the description of a task given INFO." (nth 4 info))
1988 (defun planner-task-link (info)
1989 "Return the page linked to by a task given INFO." (nth 5 info))
1990 (defun planner-task-link-text (info)
1991 "Return the link text of a task given INFO." (nth 6 info))
1992 (defun planner-task-plan (info)
1993 "Return the planner page of a task given INFO." (nth 7 info))
1994 (defun planner-task-date (info)
1995 "Return the planner date of a task given INFO." (nth 8 info))
1996 (defun planner-task-link-as-list (info)
1997 "Return a list of all the pages this task is on."
1998 (delq nil (list (nth 7 info) (nth 8 info))))
2000 ;;;_ + Creation
2002 (defvar planner-create-task-from-info-function
2003 'planner-create-task-from-info-basic
2004 "Function for creating tasks.
2005 Should accept the same arguments as `planner-create-task-from-info-basic'.")
2007 (defun planner-create-task-from-info (info &optional priority number status description link-text date plan)
2008 "Create a task in the date and plan pages based on INFO.
2009 Optional arguments PRIORITY, NUMBER, STATUS, DESCRIPTION,
2010 LINK-TEXT, DATE, and PLAN override those in INFO."
2011 (funcall planner-create-task-from-info-function info priority
2012 number status description link-text date plan))
2014 (defun planner-create-task-from-info-basic
2015 (info &optional priority number status description link-text date plan)
2016 "Create a task in the date and plan pages based on INFO.
2017 Optional arguments PRIORITY, NUMBER, STATUS, DESCRIPTION,
2018 LINK-TEXT, DATE, and PLAN override those in INFO."
2019 (save-window-excursion
2020 (save-excursion
2021 ;; page-name priority number status description
2022 ;; link link-text plan date
2023 ;; Create the task in the plan page
2024 (let ((plan-page (or plan (planner-task-plan info)))
2025 (date-page (or date (planner-task-date info)))
2026 (live-buffers
2027 (and (equal planner-tasks-file-behavior 'close)
2028 (buffer-list))))
2029 (when plan-page
2030 (if (string-match planner-date-regexp
2031 plan-page)
2032 (setq plan-page nil)))
2033 (when (and plan-page (not (string= plan-page "")))
2034 (planner-find-file plan-page)
2035 (planner-seek-task-creation-point)
2036 (insert (planner-format-task info priority number
2037 status description
2038 (planner-make-link date-page)
2039 (planner-make-link date-page))
2040 "\n"))
2041 ;; Create the task in the date page
2042 (when (and date-page (not (string= date-page "")))
2043 (planner-goto date-page)
2044 (planner-seek-task-creation-point)
2045 (insert (planner-format-task info priority number
2046 status description
2048 link-text
2049 (planner-task-link-text info))
2050 plan-page) "\n"))
2051 (forward-line -1)
2052 (run-hooks 'planner-create-task-hook)
2053 (when planner-tasks-file-behavior
2054 (planner-save-buffers live-buffers t))))))
2056 (defvar planner-task-format "#%s%s %s %s%s"
2057 "Format used by `planner-format-task' when inserting new tasks.")
2059 (defun planner-format-task
2060 (task-info &optional priority number status description link-text link)
2061 "Return a string containing TASK-INFO ready to be inserted into a page.
2062 Non-nil values of PRIORITY, NUMBER, STATUS, DESCRIPTION, LINK-TEXT,
2063 and LINK override TASK-INFO."
2064 (format planner-task-format
2065 (or priority (planner-task-priority task-info))
2066 (if planner-use-task-numbers
2067 (format "%-2s" (or number (planner-task-number task-info) ""))
2069 (or status (planner-task-status task-info))
2070 (or description (planner-task-description task-info))
2071 (let ((text (or link-text
2072 (and link (planner-make-link link))
2073 (planner-task-link-text task-info))))
2074 (if (and text (not (equal text "")))
2075 (concat " ("
2076 text
2077 ")")
2078 ""))))
2080 ;;;_ + Scheduling
2082 (defun planner-copy-or-move-region (beg end &optional date muffle-errors)
2083 "Move all tasks from BEG to END to DATE.
2084 If this is the original task, it copies it instead of moving.
2085 Most of the time, the original should be kept in a planning file,
2086 but this is not required. If BEG is at the end of a line, the
2087 first task moved will be the one on the following line. If END is
2088 at the beginning of a line, the last task moved will be the one
2089 on the previous line. If MUFFLE-ERRORS is non-nil, no errors will
2090 be reported."
2091 (interactive "r")
2092 (unless date (setq date
2093 (let ((planner-expand-name-favor-future-p
2094 (or planner-expand-name-favor-future-p
2095 planner-task-dates-favor-future-p)))
2096 (planner-read-date))))
2097 (let ((start (if (< beg end) beg end))
2098 (finish (if (< beg end) end beg))
2099 (buffer (current-buffer))
2100 (error-count 0)
2101 (count 0)
2102 (live-buffers (when (equal planner-tasks-file-behavior
2103 'close)
2104 (buffer-list))))
2105 ;; Invoke planner-copy-or-move-task on each line in reverse
2106 (let ((planner-tasks-file-behavior nil)
2107 (task-info)
2108 prev-point)
2109 (save-excursion
2110 (save-restriction
2111 (narrow-to-region
2112 (and (goto-char (1+ start)) (planner-line-beginning-position))
2113 (and (goto-char (1- finish))
2114 (min (point-max)
2115 (1+ (planner-line-end-position)))))
2116 (when planner-add-task-at-end-flag
2117 (reverse-region (point-min) (point-max)))
2118 (goto-char (point-max))
2119 (setq prev-point (point))
2120 (while (not (and (bobp)
2121 (= (point) prev-point)))
2122 (forward-line 0)
2123 (setq prev-point (point))
2124 (setq task-info (planner-current-task-info))
2125 ;; Don't move completed or cancelled tasks
2126 (if (and task-info
2127 (not (member (planner-task-status task-info) '("C" "X"))))
2128 (condition-case err
2129 (when (planner-copy-or-move-task date)
2130 (setq count (1+ count)))
2131 (error
2132 (unless (or muffle-errors (not (interactive-p)))
2133 (message
2134 "Error with %s: %s"
2135 (planner-task-description (planner-current-task-info)) err)
2136 (setq error-count (1+ error-count)))
2137 (forward-line -1)
2138 nil))
2139 (forward-line -1)))
2140 (when planner-add-task-at-end-flag
2141 (reverse-region (point-min) (point-max)))
2142 (when (and (not muffle-errors)
2143 (not error-count)
2144 (> error-count 0)
2145 (interactive-p))
2146 (message (if (> error-count 1) "%d errors." "%d error.")
2147 error-count)))))
2148 (when planner-tasks-file-behavior
2149 (planner-save-buffers live-buffers))
2150 (set-buffer buffer)
2151 count)) ; Return the number of tasks moved.
2153 ;;;_ + Navigation
2155 (defvar planner-jump-to-linked-task-function 'planner-jump-to-linked-task-basic
2156 "Function to jump to a linked task. Function should have one
2157 optional parameter: TASK-INFO.")
2159 (defun planner-jump-to-linked-task (&optional task-info)
2160 "Display the task page linked to by the current task or TASK-INFO."
2161 (funcall planner-jump-to-linked-task-function task-info))
2163 (defun planner-jump-to-linked-task-basic (&optional task-info)
2164 "Display the task page linked to by the current task or TASK-INFO."
2165 (interactive)
2166 (let* ((task-info (or task-info (planner-current-task-info)))
2167 (link (and task-info (planner-task-link task-info))))
2168 (when (planner-local-page-p link)
2169 (planner-find-file (planner-task-link task-info))
2170 (widen)
2171 (goto-char (point-min))
2172 (when (search-forward (planner-task-description task-info) nil t)
2173 (beginning-of-line)
2174 t))))
2176 ;;;_ + Convenience
2178 (defvar planner-history-list nil "History list for pages.")
2180 (defvar planner-read-name-function 'planner-read-name-single
2181 "Function to call in order to read the names of pages.")
2183 (defun planner-read-name (file-alist &optional prompt initial)
2184 "Read the name of a valid Wiki page from minibuffer.
2185 FILE-ALIST is a list of (page-name . filename) entries. If PROMPT
2186 is non-nil, it is used as the prompt string. If INITIAL is specified,
2187 it is used as a reasonable default."
2188 (funcall planner-read-name-function file-alist prompt initial))
2190 (defun planner-read-name-single (file-alist &optional prompt initial)
2191 "Read the name of a valid Wiki page from minibuffer with completion.
2192 FILE-ALIST is a list of (page-name . filename) entries. If PROMPT
2193 is non-nil, it is used as the prompt string. If INITIAL is specified,
2194 it is used as a reasonable default."
2195 (let* ((default planner-default-page)
2196 (str (completing-read
2197 (format "%s(default: %s) " (or prompt "Page: ") default)
2198 file-alist nil nil initial 'planner-history-list)))
2199 (cond
2200 ((or (null str) (= (length str) 0)) default)
2201 ((string= str "nil") nil)
2202 (t str))))
2204 (defun planner-read-name-no-completion (names &optional prompt initial)
2205 "Read the name of a valid Wiki page from minibuffer without completion.
2206 FILE-ALIST is a list of (page-name . filename) entries. If PROMPT
2207 is non-nil, it is used as the prompt string. If INITIAL is specified,
2208 it is used as a reasonable default."
2209 (let* ((default planner-default-page)
2210 (str (read-string
2211 (format "%s(default: %s) " (or prompt "Page: ") default)
2212 initial 'planner-history-list default)))
2213 (cond
2214 ((or (null str) (= (length str) 0)) default)
2215 ((string= str "nil") nil)
2216 (t str))))
2218 (defun planner-read-non-date-page (file-alist &optional prompt initial)
2219 "Prompt for a page name that does not match `planner-date-regexp'.
2220 Base completion on FILE-ALIST. If PROMPT is non-nil, use that as
2221 the prompt. If INITIAL is non-nil, use that as the initial contents
2222 of the minibuffer."
2223 (planner-read-name
2224 (delq nil
2225 (mapcar
2226 (lambda (item)
2227 (unless (string-match
2228 (concat "^\\(?:" planner-date-regexp "\\)$")
2229 (car item))
2230 item))
2231 (copy-alist file-alist)))
2232 prompt initial))
2234 (defvar planner-find-task-function 'planner-find-task-basic
2235 "Function to find a task based on INFO and POINT.")
2237 (defun planner-find-task (info &optional point)
2238 "Move point to the character before the task described by INFO.
2239 If POINT is specified, start search from that point."
2240 (funcall planner-find-task-function info point))
2242 (defun planner-find-task-basic (info &optional point)
2243 "Move point to the character before the task described by INFO.
2244 If POINT is specified, start search from that point."
2245 (goto-char (or point (point-min)))
2246 (when (re-search-forward
2247 (concat
2248 "^#[A-C][0-9]*\\s-+.\\s-+"
2249 (regexp-quote (planner-task-description info))) nil t)
2250 (goto-char (planner-line-beginning-position))))
2252 (defun planner-tasks-equal-p (task-a task-b)
2253 "Return t if TASK-A and TASK-B are equivalent.
2254 This is true if they have the same value for priority, status,
2255 description, plan and date."
2256 (and (string= (or (planner-task-priority task-a) "")
2257 (or (planner-task-priority task-b) ""))
2258 (string= (or (planner-task-status task-a) "")
2259 (or (planner-task-status task-b) ""))
2260 (string= (or (planner-task-description task-a) "")
2261 (or (planner-task-description task-b) ""))
2262 (string= (or (planner-task-plan task-a) "")
2263 (or (planner-task-plan task-b) ""))
2264 (string= (or (planner-task-date task-a) "")
2265 (or (planner-task-date task-b) ""))))
2267 (defun planner-save-buffers (&optional buffer-list suppress-fixing skip-buffer)
2268 "Save all planner buffers.
2269 If BUFFER-LIST is a list of buffers, close all buffers not found
2270 in that list. If SUPPRESS-FIXING is non-nil, do not perform any
2271 planner-related modifications such as task sorting. If
2272 SKIP-BUFFER is non-nil, do not save that buffer."
2273 (interactive)
2274 (setq suppress-fixing (and (not planner-tasks-never-suppress-fixing-flag)
2275 suppress-fixing))
2276 (mapcar
2277 (lambda (buffer)
2278 (unless (eq buffer skip-buffer)
2279 (with-current-buffer buffer
2280 ;; Save all planner buffers
2281 (when (and (planner-derived-mode-p 'planner-mode)
2282 buffer-file-name
2283 (planner-page-name)
2284 (not (string= "" (planner-page-name))))
2285 ;; SUPPRESS-FIXING is negated in the following forms because
2286 ;; it makes more sense to let planner-save-buffers do the
2287 ;; usual actions when the parameter is omitted.
2288 (let ((planner-sort-tasks-automatically
2289 (and planner-sort-tasks-automatically
2290 (not suppress-fixing)))
2291 (planner-renumber-tasks-automatically
2292 (and planner-renumber-tasks-automatically
2293 (not suppress-fixing)))
2294 (planner-align-tasks-automatically
2295 (and planner-align-tasks-automatically
2296 (not suppress-fixing)))
2297 (planner-renumber-notes-automatically
2298 (and planner-renumber-notes-automatically
2299 (not suppress-fixing)))
2300 (planner-tasks-save-behavior nil)
2301 (planner-id-update-automatically nil))
2302 (when (buffer-modified-p)
2303 (save-buffer)))
2304 (when (and buffer-list
2305 (not (memq buffer buffer-list)))
2306 (kill-buffer nil))))))
2307 (buffer-list)))
2309 ;;;_ + Extraction
2311 (defvar planner-task-regexp (concat "^#[A-C][0-9]*\\s-+.\\s-+")
2312 "Regexp used to match tasks.")
2314 (defvar planner-live-task-regexp "^#[ABC][0-9]*\\s-+[_oDP]\\s-+"
2315 "Regular expression matching \"live\" tasks.
2316 A task is live if it is not finished and it is not cancelled.")
2318 (defun planner-extract-tasks (pages &optional condition)
2319 "Parse PAGES and extract all tasks.
2320 If CONDITION is non-nil, it should be a function that
2321 accepts the task info as an argument and returns t if
2322 the task should be added to the list."
2323 (with-temp-buffer
2324 (unless (consp (car pages))
2325 (let ((list (planner-file-alist)))
2326 (setq pages (mapcar '(lambda (page)
2327 (cons page (cdr (assoc page list))))
2328 pages))))
2329 (let (result)
2330 (while pages
2331 (erase-buffer)
2332 (insert-file-contents (cdar pages))
2333 (goto-char (point-max))
2334 (while (re-search-backward "^#[A-C]" nil t)
2335 (let ((info
2336 (planner-task-info-from-string
2337 (caar pages)
2338 (buffer-substring
2339 (planner-line-beginning-position)
2340 (planner-line-end-position)))))
2341 (when (and info
2342 (if condition
2343 (funcall condition info)
2345 (setq result (append (list info) result)))))
2346 (setq pages (cdr pages)))
2347 result)))
2349 (defun planner-extract-tasks-with-status (pages status)
2350 "Return all tasks on PAGES with the specified STATUS."
2351 (planner-extract-tasks pages
2352 (lambda (item)
2353 (equal (planner-task-status item)
2354 status))))
2356 (defun planner-tasks-tag (beg end attrs)
2357 "Replace the region BEG to END with a report of tasks.
2358 If status is specified in ATTRS, list tasks matching that status only.
2359 To negate the sense of a match, use a regexp."
2360 (delete-region beg end)
2361 (let* ((status (cdr (assoc "status" attrs)))
2362 (tasks (planner-extract-tasks
2363 (planner-get-day-pages nil nil t)
2364 (if status
2365 (lambda (item)
2366 (string-match status (planner-task-status item)))
2367 nil))))
2368 (while tasks
2369 (insert
2370 (planner-make-link (planner-task-page (car tasks)) nil t)
2371 " | "
2372 (planner-task-priority (car tasks))
2373 " | "
2374 (planner-task-status (car tasks))
2375 " | "
2376 (planner-task-description (car tasks))
2377 "\n")
2378 (setq tasks (cdr tasks)))))
2380 (defvar planner-on-date-page nil
2381 "Internal variable used in `planner-sort-tasks-default-key'.")
2383 (defun planner-sort-tasks-default-key ()
2384 "Provide old sorting behavior.
2385 Day pages sort by status and priority. Plan pages sort by date,
2386 status and priority."
2387 (if planner-on-date-page
2388 (planner-sort-tasks-basic)
2389 (planner-sort-tasks-by-date)))
2391 (defun planner-sort-tasks-basic ()
2392 "Sort tasks by status (_PDXC) and priority (ABC)."
2393 (skip-chars-forward "#ABC")
2394 (let ((case-fold-search t)
2395 (ch (char-before))
2396 status)
2397 (skip-chars-forward "0123456789 ")
2398 (setq status (char-after))
2399 (+ ;(read (current-buffer))
2400 (cond
2401 ((eq status ?P) 1000)
2402 ((eq status ?D) 2000)
2403 ((eq status ?X) 3000)
2404 ((eq status ?C) 4000)
2405 (t 0))
2406 (cond ((eq ch ?A) 100)
2407 ((eq ch ?B) 200)
2408 ((eq ch ?C) 300)
2409 (t 0)))))
2411 (defun planner-sort-tasks-by-date ()
2412 "Sort tasks by date, status and priority."
2413 (skip-chars-forward "#ABC")
2414 (let ((ch (char-before))
2415 status)
2416 (skip-chars-forward "0123456789 ")
2417 (setq status (char-after))
2418 (goto-char (planner-line-end-position))
2419 (skip-chars-backward "]) ")
2420 (format "%1c%1c%10s"
2421 (if (or (= status ?X)
2422 (= status ?C))
2423 status ?\ )
2425 (if (= (skip-chars-backward "0123456789.")
2426 -10)
2427 (buffer-substring (point)
2428 (+ 10 (point)))
2429 planner-sort-undated-tasks-equivalent))))
2431 (defun planner-sort-tasks-by-link ()
2432 "Sort tasks by status, priority and link."
2433 (let ((info (planner-current-task-info)))
2434 (concat ;(read (current-buffer))
2435 (cond
2436 ((string= (planner-task-status info) "P") "1")
2437 ((string= (planner-task-status info) "D") "2")
2438 ((string= (planner-task-status info) "X") "3")
2439 ((string= (planner-task-status info) "C") "4")
2440 (t "0"))
2441 (planner-task-priority info)
2442 (or (planner-task-link info) ""))))
2444 (defun planner-sort-tasks ()
2445 "Sort the tasks.
2446 On day pages, sort according to priority and position. On plan
2447 pages, sort according to status, priority, date, and position."
2448 (interactive)
2449 (let ((case-fold-search nil)
2450 (planner-on-date-page (string-match planner-date-regexp
2451 (planner-page-name)))
2452 (old-task (planner-current-task-info))
2453 (line-offset (- (point) (planner-line-beginning-position)))
2454 (old-point (point)))
2455 (goto-char (point-min))
2456 (while (re-search-forward "^#[A-C][0-9]*" nil t)
2457 (goto-char (match-beginning 0))
2458 (let ((here (point)))
2459 (while (and (char-after) (= (char-after) ?#))
2460 (forward-line 1))
2461 (save-restriction
2462 (narrow-to-region here (point))
2463 (goto-char here)
2464 (condition-case err
2465 (sort-subr nil
2466 'forward-line 'end-of-line
2467 planner-sort-tasks-key-function nil
2468 nil)
2469 (wrong-number-of-arguments ; OLD EMACS, 5 args
2470 (sort-subr nil
2471 'forward-line 'end-of-line
2472 planner-sort-tasks-key-function nil)))
2473 (goto-char (point-max)))))
2474 (if old-task
2475 (progn
2476 (planner-find-task old-task)
2477 (forward-char line-offset))
2478 (goto-char old-point))
2479 nil)) ; Must return nil because of write-file-functions
2481 (defun planner-sort-tasks-maybe ()
2482 "Sort tasks depending on `planner-sort-tasks-automatically'."
2483 (when planner-sort-tasks-automatically
2484 (planner-sort-tasks)))
2486 (defun planner-renumber-tasks ()
2487 "Update task numbering to be in sequence once again."
2488 (interactive)
2489 (let ((old-point (point)))
2490 (goto-char (point-min))
2491 (let ((counters (list (cons "A" 1) (cons "B" 1) (cons "C" 1))))
2492 (while (re-search-forward "^#\\([A-C]\\)\\([0-9]+\\)" nil t)
2493 (let ((counter (assoc (match-string 1) counters)))
2494 (replace-match (number-to-string (cdr counter)) t t nil 2)
2495 (setcdr counter (1+ (cdr counter))))))
2496 (goto-char old-point))
2497 nil) ; Must return nil because of write-file-functions
2499 (defun planner-renumber-tasks-maybe ()
2500 "Renumber tasks depending on `planner-renumber-tasks-automatically'."
2501 (when planner-renumber-tasks-automatically
2502 (planner-renumber-tasks)))
2504 (defun planner-fix-tasks ()
2505 "Sort, renumber and align tasks."
2506 (interactive)
2507 (planner-sort-tasks)
2508 (planner-renumber-tasks)
2509 (planner-align-tasks))
2511 ;;;_ + Notes
2513 ;;;###autoload
2514 (defun planner-create-note (&optional page)
2515 "Create a note to be remembered in PAGE (today if PAGE is nil).
2516 If `planner-reverse-chronological-notes' is non-nil, create the
2517 note at the beginning of the notes section; otherwise, add it to
2518 the end. Position point after the anchor."
2519 (interactive (list (and (planner-derived-mode-p 'planner-mode)
2520 (planner-page-name))))
2521 (planner-goto (or page
2522 (and (planner-derived-mode-p 'planner-mode)
2523 (planner-page-name))
2524 (planner-today)))
2525 (planner-seek-to-first 'notes)
2526 (save-restriction
2527 (when (planner-narrow-to-section 'notes)
2528 (let ((total 0))
2529 (goto-char (point-min))
2530 (while (re-search-forward "^\.#\\([0-9]+\\)\\s-+" nil t)
2531 (setq total (max total (string-to-number (match-string 1)))))
2532 (if planner-reverse-chronological-notes
2533 (progn (goto-char (point-min))
2534 (forward-line 1)
2535 (skip-chars-forward "\n"))
2536 (goto-char (point-max))
2537 (skip-chars-backward "\n")
2538 (when (= (forward-line 1) 1) (insert "\n"))
2539 (when (= (forward-line 1) 1) (insert "\n")))
2540 (insert ".#" (number-to-string (1+ total)) " ")
2541 (unless (eobp) (save-excursion (insert "\n\n")))
2542 (1+ total)))))
2544 (defun planner-delete-note ()
2545 "Delete the current note."
2546 (interactive)
2547 (save-window-excursion
2548 (let ((info (planner-current-note-info)))
2549 (when info
2550 (save-window-excursion
2551 (when (planner-jump-to-linked-note info)
2552 (save-restriction
2553 (planner-narrow-to-note)
2554 (delete-region (point-min) (point-max)))))
2555 (save-restriction
2556 (planner-narrow-to-note)
2557 (delete-region (point-min) (point-max)))))))
2559 (defun planner-format-note (info &optional anchor title timestamp link body)
2560 "Return the string representation of INFO.
2561 ANCHOR, TITLE, TIMESTAMP, LINK and BODY override INFO if present."
2562 (unless anchor (setq anchor (planner-note-anchor info)))
2563 (unless title (setq title (planner-note-title info)))
2564 (unless timestamp (setq timestamp (planner-note-timestamp info)))
2565 (unless link (setq link (planner-note-link info)))
2566 (unless body (setq body (planner-note-body info)))
2567 (concat (if (and anchor (not (string= "" anchor)))
2568 (concat ".#" anchor " ")
2570 title
2571 (if (and timestamp (not (string= "" timestamp)))
2572 (concat " " timestamp)
2574 (if (and link (not (string= "" link))) (concat " (" link ")") "")
2575 (if (and body (not (string= "" body))) body "")))
2577 (defun planner-update-note ()
2578 "Copy the text from this note to the linked note, if any."
2579 (interactive)
2580 (save-window-excursion
2581 (let ((info (planner-current-note-info))
2582 text)
2583 (save-restriction
2584 (when (planner-narrow-to-note)
2585 (setq text (buffer-substring-no-properties (point-min) (point-max)))
2586 ;; Get rid of the anchor.
2587 (when (string-match "^\\.#[0-9]+\\s-+" text)
2588 (setq text (replace-match "" nil t text)))
2589 ;; Get rid of the link
2590 (when (string-match "\\s-+(\\[\\[.+?\\]\\])" text)
2591 (setq text (replace-match "" nil t text)))))
2592 ;; Insert the new body
2593 (when (planner-jump-to-linked-note)
2594 (save-restriction
2595 (when (planner-narrow-to-note)
2596 (goto-char (point-min))
2597 (skip-chars-forward ".#0-9")
2598 (delete-region (point) (point-max))
2599 (insert " " text)
2600 (goto-char (point-min))
2601 (goto-char (planner-line-end-position))
2602 (insert " ("
2603 (planner-make-link
2604 (concat (planner-note-page info) "#"
2605 (planner-note-anchor info)))
2606 ")")))))))
2608 ;; Case 1a: Date and plan page exist, new plan page wanted
2609 ;; Case 1b: Date page exists, no plan yet, plan page wanted
2610 ;; Case 2: Date and plan page exist, no plan page wanted
2611 ;; Case 3: No date, just plan page
2612 (defun planner-replan-note (page)
2613 "Change or assign the plan page for the current note.
2614 PAGE-NAME is the new plan page for the note."
2615 (interactive
2616 (list (planner-read-non-date-page
2617 (planner-file-alist) nil
2618 (planner-note-link-text (planner-current-note-info)))))
2619 (let ((info (planner-current-note-info t)))
2620 (when (and page
2621 (or (string= page (planner-note-plan info))
2622 (string= page (planner-note-date info))))
2623 (error "Same plan page"))
2624 (when (null (or page (planner-note-date info)))
2625 (error "Cannot unplan note without day page"))
2626 (save-window-excursion
2627 ;; Delete the old plan note
2628 (when (planner-note-plan info)
2629 (when (string-match planner-date-regexp (planner-note-page info))
2630 (planner-jump-to-linked-note info))
2631 (save-restriction
2632 (planner-narrow-to-note)
2633 (delete-region (point-min) (point-max))))
2634 (let (new)
2635 (when page
2636 ;; Create note on plan page
2637 (setq new (planner-create-note page))
2638 (insert (planner-format-note
2639 info "" nil nil
2640 (if (planner-note-date info)
2641 (planner-make-link
2642 (concat (planner-note-date info)
2644 (planner-note-anchor info)))
2645 ""))))
2646 ;; Update note on date page, if any
2647 (forward-line -1)
2648 (when (planner-note-date info)
2649 (if (string-match planner-date-regexp (planner-note-page info))
2650 (progn
2651 (planner-find-file (planner-note-date info))
2652 (goto-char (point-min))
2653 (re-search-forward (concat "^\\.#" (planner-note-anchor info)
2654 "\\s-")
2655 nil t))
2656 (planner-jump-to-linked-note info))
2657 (save-restriction
2658 (planner-narrow-to-note)
2659 (delete-region (point-min) (point-max))
2660 (insert (planner-format-note
2661 info nil nil nil
2662 (if new
2663 (planner-make-link
2664 (concat (planner-link-base page) "#"
2665 (number-to-string new)))
2666 "")))))))))
2668 ;; Improvements:
2670 ;; - Link back to the task? If we can figure out how to stably link to
2671 ;; a task in the first place...
2673 ;; - Should plan-page-p default to t? be a customizable variable? What
2674 ;; should it be called? I have the urge to write
2675 ;; planner-create-note-from-task-behavior which can have the
2676 ;; following values: 'day, 'plan, 'copy, 'xref ...
2678 (defun planner-create-note-from-task (&optional plan-page-p)
2679 "Create a note based on the current task.
2680 Argument PLAN-PAGE-P is used to determine whether we put the new
2681 note on the task's plan page or on the current page."
2682 (interactive "P")
2683 (let ((task-info (planner-current-task-info))
2684 note-num)
2685 (when task-info
2686 ;; If PLAN-PAGE-P and the task has a plan page, create a note on
2687 ;; the plan page. If not, create it on the current page.
2688 (when (and plan-page-p
2689 (string= (planner-task-date task-info)
2690 (planner-task-page task-info)))
2691 (planner-jump-to-linked-task task-info))
2692 (setq note-num (planner-create-note (planner-page-name)))
2693 (save-excursion
2694 (save-window-excursion
2695 (when (planner-find-task task-info)
2696 (planner-edit-task-description
2697 (concat (planner-task-description task-info) " "
2698 (planner-make-link
2699 (concat (planner-page-name) "#"
2700 (number-to-string note-num))
2701 (format "(%d)" note-num)))))))
2702 (insert " " (planner-task-description task-info) "\n\n"))))
2704 (defun planner-create-note-from-context (&optional plan-page-p)
2705 "Create a note based on the current context.
2706 If on a task item, call `planner-create-note-from-task'.
2707 Anywhere else, call `Footnote-add-footnote' if footnote has been
2708 loaded, else, call `planner-create-note'."
2711 (defun planner-narrow-to-note (&optional page note-number)
2712 "Narrow to the specified note. Widen and return nil if note is not found.
2713 If PAGE is nil, use current page.
2714 If NOTE-NUMBER is nil, use current note.
2715 Undefined behavior if PAGE is (non-nil and not today) and NOTE-NUMBER is nil."
2716 (when page (planner-goto page))
2717 (save-excursion
2718 (let (beginning)
2719 (if note-number
2720 (progn
2721 (goto-char (point-min))
2722 (when (re-search-forward (concat "^\\.#" note-number) nil t)
2723 (setq beginning (match-beginning 0))))
2724 (goto-char (planner-line-end-position))
2725 (when (re-search-backward "^\\.#[0-9]+" nil t)
2726 (setq beginning (planner-line-beginning-position))))
2727 (when beginning
2728 ;; Search for the end
2729 (forward-line 1)
2730 (narrow-to-region
2731 beginning
2732 (or (save-excursion
2733 (and (re-search-forward "^\\(\\.#\\|* \\)" nil t)
2734 (match-beginning 0)))
2735 (point-max)))
2736 t))))
2738 (defun planner-note-page (note-info)
2739 "Return the page specified by NOTE-INFO."
2740 (elt note-info 0))
2741 (defun planner-note-anchor (note-info)
2742 "Return the anchor specified by NOTE-INFO."
2743 (elt note-info 1))
2744 (defun planner-note-title (note-info)
2745 "Return the title specified by NOTE-INFO."
2746 (elt note-info 2))
2747 (defun planner-note-timestamp (note-info)
2748 "Return the timestamp specified by NOTE-INFO."
2749 (elt note-info 3))
2750 (defun planner-note-link (note-info)
2751 "Return the link specified by NOTE-INFO."
2752 (elt note-info 4))
2753 (defun planner-note-link-text (note-info)
2754 "Return the link text specified by NOTE-INFO."
2755 (elt note-info 4))
2756 (defun planner-note-body (note-info)
2757 "Return the timestamp specified by NOTE-INFO."
2758 (elt note-info 5))
2760 (defun planner-note-date (note-info)
2761 "Return the date for NOTE-INFO."
2762 (cond
2763 ((string-match planner-date-regexp (planner-note-page note-info))
2764 (planner-note-page note-info))
2765 ((and (planner-note-link note-info)
2766 (string-match planner-date-regexp (planner-note-link note-info)))
2767 (planner-link-base (planner-note-link note-info)))))
2769 (defun planner-note-plan (note-info)
2770 "Return the date for NOTE-INFO."
2771 (cond
2772 ((null (string-match planner-date-regexp (planner-note-page note-info)))
2773 (planner-note-page note-info))
2774 ((and (planner-note-link note-info)
2775 (null (string-match planner-date-regexp
2776 (planner-note-link note-info))))
2777 (planner-link-base (planner-note-link note-info)))))
2779 (defun planner-current-note-info (&optional include-body)
2780 "Parse the current note and return the note information as a list.
2781 The list is of the form (PAGE ANCHOR TITLE TIMESTAMP LINK BODY).
2782 If INCLUDE-BODY is non-nil, the list will include the body of the
2783 note."
2784 (save-excursion
2785 (save-restriction
2786 (when (planner-narrow-to-note)
2787 (goto-char (point-min))
2788 (when (looking-at "^\\.#\\([0-9]+\\)\\s-+\\(.+\\)")
2789 (let ((anchor (planner-match-string-no-properties 1))
2790 (title (planner-match-string-no-properties 2))
2791 timestamp link)
2792 (when (string-match
2793 (concat
2794 "\\s-+(\\("
2795 (if (featurep 'planner-multi)
2796 (concat "\\(" muse-explicit-link-regexp "\\)"
2797 "\\("
2798 (regexp-quote planner-multi-separator)
2799 muse-explicit-link-regexp
2800 "\\)*")
2801 muse-explicit-link-regexp)
2802 "\\))\\s-*$")
2803 title)
2804 (setq link (planner-match-string-no-properties 1 title))
2805 (setq title (replace-match "" nil t title)))
2806 (when (string-match "\\s-*\\([0-9]+:[0-9][0-9]\\)" title)
2807 (setq timestamp (planner-match-string-no-properties 1 title))
2808 (setq title (replace-match "" nil t title)))
2809 (list (planner-page-name) anchor title timestamp link
2810 (and include-body (buffer-substring-no-properties
2811 (planner-line-end-position)
2812 (point-max))))))))))
2814 (defun planner-search-notes-internal (regexp &optional limit include-body)
2815 "Return an alist of all notes in daily plan pages containing REGEXP.
2816 The alist is of the form ((REFERENCE TITLE BODY) (REFERENCE TITLE BODY)
2817 ...). If LIMIT is non-nil, do not search days before LIMIT. If
2818 INCLUDE-BODY is non-nil, return the body text, else return nil."
2819 (let ((pages (planner-get-day-pages limit t))
2820 filename
2821 page start anchor text results title page-results)
2822 (while pages
2823 (setq page (caar pages)
2824 filename (cdar pages))
2825 (with-temp-buffer
2826 (when (file-readable-p filename)
2827 (insert-file-contents filename)
2828 (setq start nil)
2829 (setq page-results nil)
2830 ;; Find the first note
2831 (when (re-search-forward "\\.\\(#[0-9]+\\)\\s-+\\(.*\\)" nil t)
2832 (setq start (match-beginning 2))
2833 (setq anchor (match-string 1))
2834 (setq title (match-string 2)))
2835 (while (re-search-forward "\\.\\(#[0-9]+\\)\\s-+\\(.*\\)" nil t)
2836 ;; The text between start and (1- (match-beginning 0))
2837 ;; is the note body.
2838 (when (save-excursion
2839 (goto-char (planner-line-beginning-position))
2840 (save-match-data (re-search-backward regexp start t)))
2841 (add-to-list 'page-results
2842 (list (concat filename anchor)
2843 (concat page anchor)
2844 title
2845 (if include-body
2846 (buffer-substring-no-properties
2847 start
2848 (planner-line-beginning-position))))))
2849 (setq start (match-beginning 2))
2850 (setq anchor (match-string 1))
2851 (setq title (match-string 2)))
2852 (when start
2853 (goto-char (point-max))
2854 (when (save-excursion (re-search-backward regexp start t))
2855 (add-to-list 'page-results
2856 (list (concat filename anchor)
2857 (concat page anchor)
2858 title
2859 (if include-body
2860 (buffer-substring-no-properties
2861 start
2862 (point)))))))
2863 (when planner-reverse-chronological-notes
2864 (setq page-results (nreverse page-results))))
2865 (setq results (append page-results results)))
2866 (setq pages (cdr pages)))
2867 results))
2869 (defun planner-jump-to-linked-note (&optional note-info)
2870 "Display the note linked to by the current note or NOTE-INFO if non-nil."
2871 (interactive)
2872 (setq note-info (or note-info (planner-current-note-info)))
2873 (when (and (planner-note-link note-info)
2874 (save-window-excursion
2875 (planner-visit-link (planner-note-link note-info))))
2876 (planner-visit-link (planner-note-link note-info))
2877 (widen)
2880 (defun planner-renumber-notes ()
2881 "Update note numbering."
2882 (interactive)
2883 (let ((old-point (point))
2884 (counter 1))
2885 (goto-char
2886 (if planner-reverse-chronological-notes (point-max) (point-min)))
2887 (while (if planner-reverse-chronological-notes
2888 (re-search-backward "^\\.#\\([0-9]+\\)" nil t)
2889 (re-search-forward "^\\.#\\([0-9]+\\)" nil t))
2890 (replace-match (number-to-string counter) t t nil 1)
2891 (when planner-reverse-chronological-notes
2892 (goto-char (planner-line-beginning-position)))
2893 (setq counter (1+ counter)))
2894 (goto-char old-point))
2895 nil) ; Must return nil because of write-file-functions
2897 (defun planner-renumber-notes-maybe ()
2898 "Renumber notes depending on `planner-renumber-notes-automatically'."
2899 (when planner-renumber-notes-automatically
2900 (planner-renumber-notes)))
2902 ;;;_ + Highlighting
2904 (defgroup planner-fontlock nil
2905 "Font-locking for planner.el pages."
2906 :prefix "planner-"
2907 :group 'planner)
2909 (defface planner-completed-task-face
2910 (if (featurep 'xemacs)
2911 '((t (:strikethru t :foreground "gray")))
2912 '((t (:strike-through t :foreground "gray"))))
2913 "Face for completed tasks."
2914 :group 'planner-fontlock)
2916 (defface planner-cancelled-task-face
2917 (if (featurep 'xemacs)
2918 '((t (:strikethru t :foreground "gray")))
2919 '((t (:strike-through t :foreground "gray"))))
2920 "Face for cancelled tasks."
2921 :group 'planner-fontlock)
2923 (defface planner-delegated-task-face
2924 '((t (:underline t)))
2925 "Face for delegated tasks."
2926 :group 'planner-fontlock)
2928 (defface planner-in-progress-task-face
2929 (if (featurep 'xemacs)
2930 '((t (:bold t)))
2931 '((t (:slant oblique))))
2932 "Face for tasks in progress."
2933 :group 'planner-fontlock)
2934 (defface planner-high-priority-task-face '((t (:foreground "red")))
2935 "Face for high-priority tasks."
2936 :group 'planner-fontlock)
2937 (defface planner-medium-priority-task-face '((t (:foreground "green")))
2938 "Face for medium-priority tasks."
2939 :group 'planner-fontlock)
2940 (defface planner-low-priority-task-face '((t (:foreground "blue")))
2941 "Face for low-priority tasks."
2942 :group 'planner-fontlock)
2944 (defface planner-note-headline-face
2945 '((((class color) (background light))
2946 (:foreground "dark slate blue" :bold t))
2947 (((class color) (background dark))
2948 (:foreground "pale turquoise" :bold t))
2949 (t (:bold t)))
2950 "Face for note headlines."
2951 :group 'planner-fontlock)
2953 ;; Thanks to Oliver (oik AT gmx DOT net)
2954 (defun planner-align-tasks ()
2955 "Align tasks neatly.
2956 You can add this to `write-file-functions'to have the tasks
2957 automatically lined up whenever you save. For best results,
2958 ensure `planner-align-tasks' is run after
2959 `planner-renumber-tasks'."
2960 (interactive)
2961 (save-excursion
2962 (goto-char (point-min))
2963 (while (re-search-forward "^#\\([A-C]\\)\\([0-9]*\\)\\(\\s-+\\)" nil t)
2964 (replace-match
2965 ;; Ugly hack!
2966 ;; (make-string (max (- (length (match-string 2))) 0) ?\s)
2967 ;; is better, but relies on a CVSism.
2968 (let ((length (length (match-string 2))))
2969 (cond
2970 ((and (= length 0) planner-use-task-numbers) " ")
2971 ((= length 1) " ")
2972 (t " ")))
2973 t t nil 3)))
2974 nil) ; Return nil so that we can add this to write-file-functions
2976 (defun planner-align-tasks-maybe ()
2977 "Align tasks depending on `planner-align-tasks-automatically'."
2978 (when planner-align-tasks-automatically
2979 (planner-align-tasks)))
2981 (defun planner-align-table ()
2982 "Align table neatly. Take account of links which hides characters when
2983 displayed.
2984 Perhaps, guts of this should really be inside muse..."
2985 (interactive)
2986 (save-excursion
2987 (when (fboundp 'align-regexp)
2988 (align-regexp (point-min) (point-max) "\\(\\s-*\\)|" 1 1 t))
2989 (goto-char (point-min))
2990 (while (re-search-forward (concat "^" muse-explicit-link-regexp) nil t)
2991 (let ((link (match-string 1))
2992 (desc (match-string 2)))
2993 (insert " "
2994 (make-string (if desc
2995 (+ 2 (length link))
2996 0) (aref " " 0)))))))
2998 ;; FIXME: Is there a better way to do this?
3000 (defun planner-highlight-region (beg end identifier priority properties)
3001 "Add the specified text properties to the overlay or region.
3002 BEG and END are the start and end of the region. IDENTIFIER is a
3003 symbol that identifies this particular overlay. PRIORITY controls
3004 how important this overlay is. PROPERTIES is a list of properties
3005 or attributes to apply."
3006 (if (featurep 'xemacs)
3007 (let ((extent (make-extent beg end)))
3008 (set-extent-properties extent properties)
3009 (set-extent-property extent 'priority priority))
3010 (if (functionp 'overlay-put)
3011 (progn
3012 (let ((overlay (make-overlay beg end)))
3013 (overlay-put overlay identifier t)
3014 (overlay-put overlay 'planner t)
3015 (overlay-put overlay 'priority priority)
3016 (while properties
3017 (overlay-put overlay (car properties) (cadr properties))
3018 (setq properties (cddr properties)))))
3019 (add-text-properties beg end properties))))
3021 (defcustom planner-hide-task-status-when-highlighting nil
3022 "*If non-nil, hide task status when font-locking."
3023 :type 'boolean
3024 :group 'planner-fontlock)
3026 (defun planner-highlight-tasks (beg end &optional verbose)
3027 "Highlight tasks from BEG to END. VERBOSE is ignored."
3028 (goto-char beg)
3029 (while (re-search-forward (concat "^#\\([A-C]\\)\\([0-9]*\\)\\s-+\\("
3030 planner-marks-regexp
3031 "\\)\\s-") end t)
3032 (let ((mark (match-string 3))
3033 (priority (match-string 1))
3034 faces)
3035 (setq faces
3036 (append
3037 (cond
3038 ((string= priority "A") '(planner-high-priority-task-face))
3039 ((string= priority "B") '(planner-medium-priority-task-face))
3040 ((string= priority "C") '(planner-low-priority-task-face)))
3041 (cond
3042 ((string= mark "X") '(planner-completed-task-face))
3043 ((string= mark "D") '(planner-delegated-task-face))
3044 ((string= mark "C") '(planner-cancelled-task-face))
3045 ((string= mark "o") '(planner-in-progress-task-face)))))
3046 (if (featurep 'xemacs)
3047 (mapcar (lambda (face)
3048 (when face
3049 (planner-highlight-region
3050 (match-beginning 0) (match-end 3) 'planner-task 50
3051 (list 'face face)))) faces)
3052 (planner-highlight-region
3053 (match-beginning 0) (match-end 3) 'planner-task 50
3054 (list 'face (mapcar 'face-attr-construct faces))))
3055 (planner-highlight-region
3056 (match-end 3) (planner-line-end-position)
3057 'planner-task
3059 (list 'face
3060 (cond
3061 ((string= mark "X") 'planner-completed-task-face)
3062 ((string= mark "D") 'planner-delegated-task-face)
3063 ((string= mark "C") 'planner-cancelled-task-face)
3064 ((string= mark "o") 'planner-in-progress-task-face))))
3065 (when planner-hide-task-status-when-highlighting
3066 (planner-highlight-region
3067 (match-beginning 3) (1+ (match-end 3))
3068 'planner-task
3070 (list 'invisible t))))))
3072 (defun planner-highlight-notes (beg end &optional verbose)
3073 "Highlight notes as second-level headers from BEG to END.
3074 VERBOSE is ignored."
3075 (goto-char beg)
3076 (while (re-search-forward "^\\.#\\([0-9]+\\) [^(\n]+" end t)
3077 (add-text-properties
3078 (match-beginning 0) (match-end 0)
3079 '(face planner-note-headline-face))))
3081 (defun planner-notes-get-headlines (&optional limit)
3082 "Return note headlines on the current page.
3083 If LIMIT is non-nil, return only that many from the top."
3084 (when (stringp limit) (setq limit (string-to-number limit)))
3085 (let (headlines)
3086 (save-excursion
3087 (save-restriction
3088 (widen)
3089 (goto-char (point-min))
3090 (while (and
3091 (re-search-forward "^.\\(#[0-9]+\\)\\s-+\\(.+\\)" nil t)
3092 (if limit
3093 (> limit 0)
3095 (add-to-list
3096 'headlines
3097 (cons
3098 (planner-match-string-no-properties 1)
3099 (planner-match-string-no-properties 2))
3101 (if limit (setq limit (1- limit))))))
3102 headlines))
3104 ;;;_* Indexing
3106 ;; I want to compress the list of day pages. Arranging them by month
3107 ;; may be a good strategy, although a calendar would be optimal.
3109 (defun planner-index ()
3110 "Display an index of all known Wiki pages."
3111 (interactive)
3112 (let ((muse-current-project (muse-project planner-project)))
3113 (message "Generating Muse index...")
3114 (pop-to-buffer (planner-generate-index))
3115 (goto-char (point-min))
3116 (planner-mode)
3117 (message "Generating Muse index...done")))
3119 (defun planner-generate-index (&optional as-list exclude-private)
3120 "Generate an index of all Wiki pages.
3121 List planner pages separately. If AS-LIST is non-nil, format it
3122 as a list. If EXCLUDE-PRIVATE is non-nil, exclude anything for
3123 which `muse-project-private-p' returns non-nil."
3124 (let ((index (planner-index-as-string as-list exclude-private)))
3125 (with-current-buffer (get-buffer-create "*Planner Index*")
3126 (erase-buffer)
3127 (insert index)
3128 (current-buffer))))
3130 (defun planner-index-as-string (&optional as-list exclude-private
3131 exclude-daypages)
3132 "Generate an index of all Wiki pages.
3133 Day pages are listed separately.
3135 If AS-LIST is non-nil, format it as a list.
3137 If EXCLUDE-PRIVATE is non-nil, exclude anything for which
3138 `muse-project-private-p' returns non-nil.
3140 If EXCLUDE-DAYPAGES is non-nil, exclude day pages from the list."
3141 (let ((index (muse-index-as-string as-list exclude-private)))
3142 (with-temp-buffer
3143 (insert index)
3144 (goto-char (point-min))
3145 (delete-matching-lines
3146 "\\[\\[[0-9][0-9][0-9][0-9]\\.[0-9][0-9]\\.[0-9][0-9]\\]\\]")
3147 (unless exclude-daypages
3148 (goto-char (point-max))
3149 (unless (bolp) (insert "\n"))
3150 (if planner-publish-dates-first-p
3151 (progn
3152 (goto-char (point-min))
3153 (insert "\n")
3154 (goto-char (point-min)))
3155 (insert "\n"))
3156 (let ((dates (mapcar 'car (planner-list-daily-files)))
3157 month last-month)
3158 (while dates
3159 (setq month (substring (car dates) 0 7))
3160 (unless (string= month last-month)
3161 (setq last-month month)
3162 (insert "\n" month " |"))
3163 (insert " [[" (car dates) "][."
3164 (substring (car dates) 8)
3165 " ]]")
3166 (setq dates (cdr dates)))
3167 (when planner-publish-dates-first-p
3168 (insert "\n"))))
3169 (buffer-string))))
3171 ;;;_ + Info
3173 (defun planner-annotation-from-info ()
3174 "If called from an info node, return an annotation.
3175 Suitable for use in `planner-annotation-functions'."
3176 (when (eq major-mode 'Info-mode)
3177 (planner-make-link
3178 (concat "info://" Info-current-file "#" Info-current-node)
3179 (if (and (not (equal Info-current-file "dir"))
3180 (equal Info-current-node "Top"))
3181 (file-name-nondirectory Info-current-file)
3182 Info-current-node)
3183 t)))
3185 (custom-add-option 'planner-annotation-functions 'planner-annotation-from-info)
3187 ;;;_ + Man
3189 (defun planner-annotation-from-man ()
3190 "If called from a man page, return an annotation.
3191 Suitable for use in `planner-annotation-functions'."
3192 (when (eq major-mode 'Man-mode)
3193 ;; There may be a better way to get the name of the current Man page.
3194 (let ((page (downcase (cadr (cdar Man-page-list)))))
3195 (planner-make-link
3196 (concat "man://" page)
3197 (concat "Man: " page) t))))
3199 (custom-add-option 'planner-annotation-functions 'planner-annotation-from-man)
3201 ;;;_ + WoMan
3203 (defun planner-annotation-from-woman ()
3204 "If called from a woman page, return an annotation.
3205 Suitable for use in `planner-annotation-functions'."
3206 (when (eq major-mode 'woman-mode)
3207 ;; You'd think there'd be a better way to get the page name.
3208 (let* ((buf (split-string (buffer-name)))
3209 (page (substring (nth 2 buf) 0 -1))
3210 (sec (nth 1 buf)))
3211 (planner-make-link
3212 (concat "woman://" page)
3213 (concat "WoMan: " page "(" sec ")") t))))
3215 (custom-add-option 'planner-annotation-functions 'planner-annotation-from-woman)
3217 ;;;_ + Common mail functions
3219 (defun planner-get-name-from-address (address)
3220 "Return the name for ADDRESS to be used in links."
3221 (let ((addr (mail-extract-address-components address)))
3222 (or (car addr) (cadr addr))))
3224 ;;;_* User functions
3226 ;;;_ + Navigation
3228 (defun planner-page-file (page &optional no-check-p)
3229 "Return a filename if PAGE exists within `planner-project'.
3230 If NO-CHECK-P is non-nil, the planner project files are always updated."
3231 (muse-project-page-file page planner-project))
3233 ;;;###autoload
3234 (defun plan (&optional force-days)
3235 "Start your planning for the day, carrying unfinished tasks forward.
3237 If FORCE-DAYS is a positive integer, search that many days in the past
3238 for unfinished tasks.
3239 If FORCE-DAYS is 0 or t, scan all days.
3240 If FORCE-DAYS is nil, use the value of `planner-carry-tasks-forward'
3241 instead, except t means scan only yesterday."
3242 ;; Special treatment of t for planner-carry-tasks-forward is for
3243 ;; backward compatibility.
3244 (interactive "P")
3245 (unless muse-project-alist
3246 (planner-display-warning
3247 (concat "The variable `muse-project-alist' has not defined.\n"
3248 "\nSee the \"Creating Your Planner\" chapter in the Planner"
3249 " manual\nfor details on how to set this up."))
3250 (error "The variable `muse-project-alist' has not been defined"))
3251 (if planner-use-day-pages
3252 (progn
3253 (unless force-days
3254 (setq force-days
3255 (if (equal planner-carry-tasks-forward t)
3257 planner-carry-tasks-forward)))
3258 (when (and (integerp force-days)
3259 (= force-days 0))
3260 (setq force-days t))
3261 (planner-goto-today)
3262 (let* ((today (planner-today))
3263 (names (planner-get-day-pages nil (planner-yesterday)))
3264 (today-buffer (current-buffer))
3265 (planner-tasks-file-behavior
3266 ;; Force saving so that the file list can be updated
3267 (or planner-tasks-file-behavior
3268 'save))
3269 (planner-use-other-window nil)
3270 (live-buffers (and
3271 (equal planner-tasks-file-behavior
3272 'close)
3273 (buffer-list))))
3274 ;; Limit the list for force-days
3275 (when (and (integerp force-days)
3276 (> (length names) force-days))
3277 (setcdr (nthcdr (1- force-days) names) nil))
3278 (when force-days
3279 (while names
3280 (find-file (cdar names))
3281 ;; Attempt to copy all the tasks
3282 (when (not (equal today (planner-page-name)))
3283 (let ((planner-tasks-file-behavior nil))
3284 (save-restriction
3285 (planner-narrow-to-section 'tasks)
3286 (planner-copy-or-move-region (point-min) (point-max)
3287 (planner-today) t)))
3288 (unless (buffer-modified-p)
3289 (kill-buffer (current-buffer))))
3290 (setq names (cdr names))))
3291 ;; Jump to the most recent daily page
3292 (if (or planner-carry-tasks-forward
3293 (planner-page-file today)
3294 (null names))
3295 (planner-goto-today)
3296 (planner-goto (caar names)))
3297 ;; Save/kill files if configured to do so
3298 (when planner-tasks-file-behavior
3299 (planner-save-buffers live-buffers))))
3300 (planner-find-file (or planner-default-page
3301 planner-initial-page))))
3303 (defvar planner-goto-hook '(planner-seek-to-first)
3304 "Functions called after a planner day page is opened.")
3306 ;;;###autoload
3307 (defun planner-goto (date &optional just-show)
3308 "Jump to the planning page for DATE.
3309 If no page for DATE exists and JUST-SHOW is non-nil, don't create
3310 a new page - simply return nil."
3311 (interactive (list (or
3312 (planner-read-date)
3313 (planner-read-non-date-page (planner-file-alist)))))
3314 (if (or (not just-show) (planner-page-exists-p date))
3315 (progn
3316 (planner-find-file date
3317 (if planner-use-other-window
3318 'find-file-other-window
3319 'find-file))
3320 (widen)
3321 (goto-char (point-min))
3322 (run-hooks 'planner-goto-hook)
3323 ;; planner-goto-hook returns nil
3325 ;; File not found, and not supposed to be created.
3326 (when (interactive-p)
3327 (message "No planner file for %s." date))
3328 ;; return nil
3329 nil))
3331 ;;;###autoload
3332 (defun planner-goto-plan-page (page)
3333 "Opens PAGE in the the `planner-project' wiki.
3334 Use `planner-goto' if you want fancy calendar completion."
3335 (interactive (list (planner-read-name (planner-file-alist))))
3336 (planner-find-file page))
3338 ;;;###autoload
3339 (defun planner-show (date)
3340 "Show the plan page for DATE in another window, but don't select it.
3341 If no page for DATE exists, return nil."
3342 (interactive (list (planner-read-date)))
3343 (save-selected-window
3344 (let ((planner-use-other-window t))
3345 (planner-goto date planner-show-only-existing))))
3347 ;;;###autoload
3348 (defun planner-goto-today ()
3349 "Jump to the planning page for today."
3350 (interactive)
3351 (planner-goto (planner-today)))
3353 ;;;###autoload
3354 (defun planner-goto-most-recent ()
3355 "Go to the most recent day with planning info."
3356 (interactive)
3357 (planner-goto
3358 (planner-get-previous-existing-day
3359 (planner-calculate-date-from-day-offset
3360 (planner-get-current-date-filename) 1))))
3362 ;;;###autoload
3363 (defun planner-goto-yesterday (&optional days)
3364 "Goto the planner page DAYS before the currently displayed date.
3365 If DAYS is nil, goes to the day immediately before the currently
3366 displayed date. If the current buffer is not a daily planner
3367 page, calculates date based on today."
3368 (interactive "p")
3369 (let ((planner-use-other-window nil))
3370 (planner-goto (planner-calculate-date-from-day-offset
3371 (planner-get-current-date-filename) (or (- days) -1)))))
3373 ;;;###autoload
3374 (defun planner-goto-tomorrow (&optional days)
3375 "Goto the planner page DAYS after the currently displayed date.
3376 If DAYS is nil, goes to the day immediately after the currently
3377 displayed date. If the current buffer is not a daily planner
3378 page, calculates date based on today."
3379 (interactive "p")
3380 (let ((planner-use-other-window nil))
3381 (planner-goto (planner-calculate-date-from-day-offset
3382 (planner-get-current-date-filename) (or days 1)))))
3384 ;;;###autoload
3385 (defun planner-goto-previous-daily-page ()
3386 "Goto the last plan page before the current date.
3387 The current date is taken from the day page in the current
3388 buffer, or today if the current buffer is not a planner page.
3389 Does not create pages if they do not yet exist."
3390 (interactive)
3391 (let ((planner-use-other-window nil))
3392 (planner-goto (planner-get-previous-existing-day
3393 (planner-get-current-date-filename)))))
3395 ;;;###autoload
3396 (defun planner-goto-next-daily-page ()
3397 "Goto the first plan page after the current date.
3398 The current date is taken from the day page in the current
3399 buffer, or today if the current buffer is not a planner page.
3400 Does not create pages if they do not yet exist."
3401 (interactive)
3402 (let ((planner-use-other-window nil))
3403 (planner-goto (planner-get-next-existing-day
3404 (planner-get-current-date-filename)))))
3406 ;;;_ + Tasks
3408 ;;;_ + Creating
3410 ;;;###autoload
3411 (defun planner-create-high-priority-task-from-buffer ()
3412 "Create a high-priority task based on this buffer.
3413 Do not use this in LISP programs. Instead, set the value of
3414 `planner-default-task-priority' and call `planner-create-task' or
3415 `planner-create-task-from-buffer'."
3416 (interactive)
3417 (let ((planner-default-task-priority "A"))
3418 (call-interactively 'planner-create-task-from-buffer)))
3420 ;;;###autoload
3421 (defun planner-create-medium-priority-task-from-buffer ()
3422 "Create a high-priority task based on this buffer.
3423 Do not use this in LISP programs. Instead, set the value of
3424 `planner-default-task-priority' and call `planner-create-task' or
3425 `planner-create-task-from-buffer'."
3426 (interactive)
3427 (let ((planner-default-task-priority "B"))
3428 (call-interactively 'planner-create-task-from-buffer)))
3430 ;;;###autoload
3431 (defun planner-create-low-priority-task-from-buffer ()
3432 "Create a high-priority task based on this buffer.
3433 Do not use this in LISP programs. Instead, set the value of
3434 `planner-default-task-priority' and call `planner-create-task' or
3435 `planner-create-task-from-buffer'."
3436 (interactive)
3437 (let ((planner-default-task-priority "C"))
3438 (call-interactively 'planner-create-task-from-buffer)))
3440 (defun planner-read-task ()
3441 "Return a list of information for a task."
3442 (list
3443 (read-string "Describe task: ")
3444 (when planner-use-day-pages
3445 (cond
3446 ;; Universal prefix means pick up from current page
3447 ((and current-prefix-arg
3448 (planner-derived-mode-p 'planner-mode)
3449 (string-match planner-date-regexp (planner-page-name)))
3450 (planner-page-name))
3451 ;; Date selected in calendar
3452 ((condition-case nil (calendar-cursor-to-date) (error nil))
3453 (planner-date-to-filename (calendar-cursor-to-date)))
3454 ;; Prompt for date
3455 (t (let ((planner-expand-name-favor-future-p
3456 (or planner-expand-name-favor-future-p
3457 planner-task-dates-favor-future-p)))
3458 (planner-read-date)))))
3459 (when planner-use-plan-pages
3460 (if (and current-prefix-arg (planner-derived-mode-p 'planner-mode)
3461 (not (string-match planner-date-regexp (planner-page-name))))
3462 ;; Universal prefix means pick up from current page
3463 (planner-page-name)
3464 (let ((planner-default-page
3465 (if (and (planner-derived-mode-p 'planner-mode)
3466 (planner-page-name)
3467 (not (string-match planner-date-regexp
3468 (planner-page-name))))
3469 (planner-page-name)
3470 planner-default-page)))
3471 (planner-read-non-date-page
3472 (planner-file-alist)))))
3473 planner-default-task-status))
3475 ;; NOTE: Prefix arg changed to prompt for PLAN-PAGE instead of
3476 ;; set to today
3477 ;;;###autoload
3478 (defun planner-create-task-from-buffer (title date &optional plan-page status)
3479 "Create a new task named TITLE on DATE based on the current buffer.
3480 With a prefix, do not prompt for PLAN-PAGE. The task is
3481 associated with PLAN-PAGE if non-nil. If STATUS is non-nil, use
3482 that as the status for the task. Otherwise, use
3483 `planner-default-task-status'. See `planner-create-task' for more
3484 information."
3485 (interactive (planner-read-task))
3486 (setq planner-default-page plan-page)
3487 (let ((planner-create-task-hook (append planner-create-task-from-buffer-hook
3488 planner-create-task-hook))
3489 (annotation (run-hook-with-args-until-success
3490 'planner-annotation-functions)))
3491 (when (and planner-annotation-symbol-string
3492 (string-match planner-annotation-symbol-string title))
3493 (setq title (replace-match (or annotation "") t t title)
3494 annotation nil))
3495 (planner-create-task title
3496 (when (and date
3497 (string-match planner-date-regexp date))
3498 date)
3499 annotation
3500 plan-page
3501 status)))
3503 (defun planner-create-task (title date &optional annotation plan-page status)
3504 "Create a new task named TITLE based on the current Wiki page.
3505 If DATE is non-nil, makes a daily entry on DATE, else makes an
3506 entry in today's planner page. It's assumed that the current Wiki
3507 page is the page you're using to plan an activity. Any time
3508 accrued to this task will be applied to that page's name in the
3509 timelog file, assuming you use timeclock. If ANNOTATION is
3510 non-nil, it will be used for the page annotation. If PLAN-PAGE is
3511 non-nil, the task is associated with the given page. If STATUS is
3512 non-nil, use that as the status for the task. Otherwise, use
3513 `planner-default-task-status'.
3515 If called with an interactive prefix argument, do not prompt for
3516 PLAN-PAGE.
3518 You probably want to call `planner-create-task-from-buffer' instead."
3519 (interactive
3520 (list
3521 (read-string "Describe task: ")
3522 (when planner-use-day-pages
3523 (cond
3524 ;; Universal prefix means pick up from current page
3525 ((and current-prefix-arg
3526 (planner-derived-mode-p 'planner-mode)
3527 (string-match planner-date-regexp (planner-page-name)))
3528 (planner-page-name))
3529 ;; Date selected in calendar
3530 ((condition-case nil (calendar-cursor-to-date) (error nil))
3531 (planner-date-to-filename (calendar-cursor-to-date)))
3532 ;; Prompt for date
3533 (t (let ((planner-expand-name-favor-future-p
3534 (or planner-expand-name-favor-future-p
3535 planner-task-dates-favor-future-p)))
3536 (planner-read-date)))))
3537 nil ;; No annotation, interactively
3538 (when planner-use-plan-pages
3539 (if (and current-prefix-arg (planner-derived-mode-p 'planner-mode)
3540 (not (string-match planner-date-regexp (planner-page-name))))
3541 ;; Universal prefix means pick up from current page
3542 (planner-page-name)
3543 (let ((planner-default-page
3544 (if (and (planner-derived-mode-p 'planner-mode)
3545 (planner-page-name)
3546 (not (string-match planner-date-regexp
3547 (planner-page-name))))
3548 (planner-page-name)
3549 planner-default-page)))
3550 (planner-read-non-date-page
3551 (planner-file-alist)))))
3552 planner-default-task-status))
3553 (setq planner-default-page plan-page)
3554 (planner-create-task-from-info
3555 nil ; info
3556 planner-default-task-priority ; priority
3557 "0" ; number
3558 (or status planner-default-task-status) ; status
3559 (if (and annotation
3560 (not (string= annotation ""))
3561 (or (not plan-page)
3562 (and
3563 (not (string= plan-page annotation))
3564 (not (string= (concat "[[" plan-page "]]") annotation)))))
3565 ;; Used C-u to make a plan-page annotation, so preserve
3566 ;; the context
3567 (concat title " : " annotation)
3568 title) ; description
3569 ;; link: If creating this from a planner plan page, use the
3570 ;; current page name
3571 (and plan-page (planner-make-link plan-page)) ; link text
3572 date
3573 plan-page))
3575 (defun planner-create-task-from-note (title date &optional plan-page status)
3576 "Create a task based on the current note with TITLE, DATE, PLAN-PAGE and
3577 STATUS.
3579 A more do-what-I-mean way to do this is to position point on the first
3580 line of a note (.#1 ...) and call `planner-create-task-from-buffer'."
3581 (interactive (let* ((info (planner-current-note-info))
3582 (planner-default-page (and info
3583 (planner-note-plan info))))
3584 (if info
3585 (planner-read-task)
3586 (error "Not in a planner note"))))
3587 (let* ((info (planner-current-note-info))
3588 (annotation (planner-make-link (concat (planner-note-page info)
3590 (planner-note-anchor info)))))
3591 (when (and planner-annotation-symbol-string
3592 (string-match planner-annotation-symbol-string title))
3593 (setq title (replace-match (or annotation "") t t title)
3594 annotation nil))
3595 (planner-create-task title
3596 (when (and date (string-match planner-date-regexp
3597 date))
3598 date)
3599 annotation
3600 plan-page
3601 status)))
3604 ;;;_ + Rescheduling
3606 (defvar planner-copy-or-move-task-suppress-duplicates t
3607 "*If non-nil, do not create duplicate tasks.")
3609 (defun planner-replan-task-basic (page-name)
3610 "Change or assign the plan page for the current task.
3611 PAGE-NAME is the new plan page for the task. Use
3612 `planner-copy-or-move-task' if you want to change the date.
3613 With a prefix, provide the current link text for editing."
3614 (interactive (list
3615 (planner-read-name
3616 (planner-file-alist) nil
3617 (when current-prefix-arg
3618 (planner-task-plan (planner-current-task-info))))))
3619 (let ((info (planner-current-task-info)))
3620 (when (and info (not (equal page-name (planner-task-plan info))))
3621 (with-planner-update-setup
3622 ;; Delete from old plan page
3623 (when (planner-task-plan info)
3624 (planner-find-file (planner-task-plan info))
3625 (when (planner-find-task info)
3626 (delete-region (planner-line-beginning-position)
3627 (1+ (planner-line-end-position)))))
3628 ;; Add to new plan page, if any, and update date
3629 (if page-name
3630 (progn
3631 (planner-find-file page-name)
3632 (planner-seek-task-creation-point)
3633 (insert (planner-format-task info nil nil nil nil
3634 (or (planner-task-date info)
3636 (or (planner-task-date info)
3637 ""))
3638 "\n")
3639 (forward-line -1)
3640 (planner-update-task))
3641 ;; Else, go to day page and update line
3642 (planner-find-file (planner-task-date info))
3643 (if (planner-find-task info)
3644 (delete-region (planner-line-beginning-position)
3645 (1+ (planner-line-end-position)))
3646 (planner-seek-task-creation-point))
3647 (insert (planner-format-task info nil nil nil nil
3648 (or (planner-make-link page-name) "")
3649 (or page-name ""))
3650 "\n"))))))
3651 (defalias 'planner-replan-task 'planner-replan-task-basic)
3653 (defun planner-seek-task-creation-point ()
3654 "Jump to point where task would be created."
3655 (planner-seek-to-first (cdr (assoc 'tasks planner-sections)))
3656 (when planner-add-task-at-end-flag
3657 (while (looking-at "^#")
3658 (forward-line))
3659 (unless (bolp) (insert "\n"))))
3661 (defun planner-copy-or-move-task-basic (&optional date force)
3662 "Move the current task to DATE.
3663 If this is the original task, it copies it instead of moving.
3664 Most of the time, the original should be kept in a planning file,
3665 but this is not required. If FORCE is non-nil, the task is moved
3666 regardless of status. It also works for creating tasks from a
3667 Note. Use `planner-replan-task' if you want to change the plan
3668 page in order to get better completion.
3669 This function is the most complex aspect of planner.el."
3670 (interactive (list (let ((planner-expand-name-favor-future-p
3671 (or planner-expand-name-favor-future-p
3672 planner-task-dates-favor-future-p)))
3673 (planner-read-date))
3674 current-prefix-arg))
3675 (if (or (null date)
3676 (string-match planner-date-regexp date))
3677 (let ((live-buffers (when (equal planner-tasks-file-behavior 'close)
3678 (buffer-list))))
3679 (when (equal date (planner-page-name))
3680 (error "Cannot move a task back to the same day"))
3681 (save-excursion
3682 (save-window-excursion
3683 (save-restriction
3684 (beginning-of-line)
3685 (let* ((task-info (planner-current-task-info))
3686 (plan-page (planner-task-plan task-info))
3687 (date-page (planner-task-date task-info)))
3688 (unless task-info
3689 (error "There is no task on the current line"))
3690 (unless force
3691 (when (equal date-page date)
3692 (error "Cannot move a task back to the same day"))
3693 (when (equal (planner-task-status task-info) "X")
3694 (error "Cannot reschedule a completed task"))
3695 (when (equal (planner-task-status task-info) "C")
3696 (error "Cannot reschedule a cancelled task")))
3697 (when (and (or (null date) (string= date "nil"))
3698 (not plan-page))
3699 (error "Cannot unset date in task not associated with plan"))
3700 ;; Delete it from the old date page
3701 (when date-page
3702 (planner-goto date-page)
3703 (goto-char (point-min))
3704 (when (planner-find-task task-info)
3705 (beginning-of-line)
3706 (delete-region (point)
3707 (min (point-max)
3708 (1+ (planner-line-end-position))))))
3709 ;; Update the new date page
3710 (unless (null date)
3711 (planner-goto date)
3712 (when (or (not planner-copy-or-move-task-suppress-duplicates)
3713 (and (not (planner-find-task task-info))))
3714 (planner-seek-task-creation-point)
3715 (insert
3716 (planner-format-task task-info
3717 nil nil nil nil
3718 (when plan-page
3719 (planner-make-link plan-page)))
3720 "\n")))
3721 ;; Update planner page
3722 (when (and plan-page
3723 (not (string-match planner-date-regexp plan-page)))
3724 (planner-find-file plan-page)
3725 (goto-char (point-min))
3726 (if (planner-find-task task-info)
3727 (progn
3728 (beginning-of-line)
3729 (delete-region (point)
3730 (min (point-max)
3731 (1+ (planner-line-end-position)))))
3732 (planner-seek-task-creation-point))
3733 (insert (planner-format-task
3734 task-info
3735 nil nil nil nil
3736 (planner-make-link date)) "\n"))
3737 t))))
3738 ;; Operation successful.
3739 (when planner-tasks-file-behavior
3740 (planner-save-buffers live-buffers t)))
3741 (when (planner-replan-task date) t)))
3742 (defalias 'planner-copy-or-move-task 'planner-copy-or-move-task-basic)
3744 ;;;_ + Deleting
3746 (defcustom planner-delete-task-hook nil
3747 "Hook called after a task has been deleted.
3748 Argument is a task information list. If a function returns nil,
3749 no other functions will be processed."
3750 :type 'hook
3751 :group 'planner-tasks)
3753 (defun planner-delete-task ()
3754 "Deletes this task from the current page and the linked page."
3755 (interactive)
3756 (save-excursion
3757 (save-window-excursion
3758 (beginning-of-line)
3759 (let* ((task-info (planner-current-task-info))
3760 (task-link (and task-info (planner-task-link task-info)))
3761 (live-buffers
3762 (and (equal planner-tasks-file-behavior 'close)
3763 (buffer-list))))
3764 (unless task-info
3765 (error "There is no task on the current line"))
3766 (beginning-of-line)
3767 (delete-region (point) (min (point-max)
3768 (1+ (planner-line-end-position))))
3769 (when (and task-link (assoc task-link (planner-file-alist))
3770 (planner-jump-to-linked-task task-info))
3771 (delete-region (planner-line-beginning-position)
3772 (min (point-max) (1+ (planner-line-end-position)))))
3773 (when planner-tasks-file-behavior
3774 (planner-save-buffers live-buffers t))
3775 (run-hook-with-args-until-failure
3776 'planner-delete-task-hook task-info)))))
3778 ;;;_ + Updating
3780 (defun planner-edit-task-description-basic (description)
3781 "Change the current task to use DESCRIPTION."
3782 (interactive (list
3783 (let* ((info (planner-current-task-info))
3784 (planner-task-history
3785 (list
3786 (planner-task-description info))))
3787 (unless info (error "No task on current line"))
3788 (read-string "New description: "
3789 (cons (planner-task-description info)
3791 '(planner-task-history . 1)
3792 (planner-task-description info)))))
3793 (let ((point (point)))
3794 (with-planner-update-setup
3795 (let ((info (planner-current-task-info))
3796 (live-buffers (and
3797 (equal planner-tasks-file-behavior 'close)
3798 (buffer-list))))
3799 (delete-region (planner-line-beginning-position)
3800 (planner-line-end-position))
3801 (insert (planner-format-task info
3802 nil nil nil
3803 description))
3804 (when (planner-task-link info)
3805 (if (planner-jump-to-linked-task info)
3806 (progn
3807 (setq info (planner-current-task-info))
3808 (delete-region (planner-line-beginning-position)
3809 (planner-line-end-position))
3810 (insert (planner-format-task info
3811 nil nil nil
3812 description)))
3813 (planner-seek-task-creation-point)
3814 (insert
3815 (planner-format-task info nil nil nil description
3816 (planner-make-link (planner-task-page info)))
3817 "\n")))))
3818 (goto-char (point))))
3819 (defalias 'planner-edit-task-description 'planner-edit-task-description-basic)
3822 (defun planner-update-task-basic ()
3823 "Update the current task's priority and status on the linked page.
3824 Tasks are considered the same if they have the same description.
3825 This function allows you to force a task to be recreated if it
3826 disappeared from the associated page.
3828 Note that the text of the task must not change. If you want to be able
3829 to update the task description, see planner-id.el."
3830 (interactive)
3831 (with-planner-update-setup
3832 (beginning-of-line)
3833 (let* ((task-info (planner-current-task-info))
3834 (task-link (and task-info
3835 (if (string-match planner-date-regexp
3836 (planner-page-name))
3837 (planner-task-plan task-info)
3838 (planner-task-date task-info))))
3839 (original (planner-page-name)))
3840 (unless task-info
3841 (error "There is no task on the current line"))
3842 ;; (unless task-link
3843 ;; (error "There is no link for the current task"))
3844 (if (planner-jump-to-linked-task task-info)
3845 ;; Already there, so update only if changed
3846 (unless (planner-tasks-equal-p task-info
3847 (planner-current-task-info))
3848 (delete-region (planner-line-beginning-position)
3849 (min (point-max) (1+ (planner-line-end-position))))
3850 (insert (planner-format-task task-info nil nil nil nil
3851 (planner-make-link
3852 original)) "\n"))
3853 ;; Not yet there, so add it
3854 (when (planner-local-page-p task-link)
3855 (planner-find-file task-link)
3856 (save-excursion
3857 (save-restriction
3858 (planner-seek-task-creation-point)
3859 (insert
3860 (planner-format-task task-info nil nil nil nil
3861 (planner-make-link original))
3862 "\n"))))))))
3864 (defalias 'planner-update-task 'planner-update-task-basic)
3866 ;;;_ + Prioritizing
3868 ;; This really should be called planner-raise/lower-task-priority, but
3869 ;; for some obscure reason, the original planner.el called the task
3870 ;; numbers priorities and "A/B/C" categories. I'm not really sure if I
3871 ;; can change the name right now. I suppose we eventually should.
3873 (defun planner-set-task-priority (priority)
3874 "Set the priority of the current task.
3875 This changes a low-priority task to a medium-priority task
3876 and a medium-priority task to a high-priority task."
3877 (let ((info (planner-current-task-info)))
3878 (when info
3879 (delete-region (planner-line-beginning-position)
3880 (min (point-max) (1+ (planner-line-end-position))))
3881 (save-excursion
3882 (insert (planner-format-task
3883 info
3884 priority) "\n"))
3885 (when (planner-task-link info)
3886 (planner-update-task)))))
3888 (defun planner-raise-task-priority ()
3889 "Raise the priority of the current task.
3890 This changes a low-priority task to a medium-priority task
3891 and a medium-priority task to a high-priority task."
3892 (interactive)
3893 (let ((info (planner-current-task-info)))
3894 (when info
3895 (delete-region (planner-line-beginning-position)
3896 (min (point-max) (1+ (planner-line-end-position))))
3897 (save-excursion
3898 (insert (planner-format-task
3899 info
3900 (cond
3901 ((string= "A" (planner-task-priority info)) "A")
3902 ((string= "B" (planner-task-priority info)) "A")
3903 ((string= "C" (planner-task-priority info)) "B")
3904 (t "C"))) "\n"))
3905 (when (planner-task-link info)
3906 (planner-update-task)))))
3908 (defun planner-lower-task-priority ()
3909 "Lower the priority of the current task.
3910 This changes a medium-priority task to a low-priority task
3911 and a high-priority task to a low-priority task."
3912 (interactive)
3913 (let ((info (planner-current-task-info)))
3914 (when info
3915 (delete-region (planner-line-beginning-position)
3916 (min (point-max) (1+ (planner-line-end-position))))
3917 (save-excursion
3918 (insert (planner-format-task
3919 info
3920 (cond
3921 ((string= "A" (planner-task-priority info)) "B")
3922 ((string= "B" (planner-task-priority info)) "C")
3923 (t "C"))) "\n"))
3924 (when (planner-task-link info)
3925 (planner-update-task)))))
3927 (defun planner-raise-task (&optional arg)
3928 "Raise the number of the current task by ARG steps. (Default: 1)"
3929 (interactive "p")
3930 (beginning-of-line)
3931 (setq arg (or arg 1)) ; ARG defaults to 1 if not specified
3932 (if (< arg 0) (planner-lower-task (- arg)))
3933 (let* ((current-task (planner-current-task-info))
3934 ;; task-seen will be the last task moved over with the same link
3935 task-seen)
3936 (unless current-task
3937 (error "Not on a task line"))
3938 ;; Store the current line in the kill ring, deleting it
3939 (kill-region (point) (1+ (planner-line-end-position)))
3940 ;; If the previous line is not a task, search for the previous block
3941 (while (> arg 0)
3942 (let ((old-point (point)))
3943 (if (= (forward-line -1) 0)
3944 (if (not (planner-current-task-info))
3945 (if (re-search-backward "^#[ABC][0-9]*[ \t]" nil t)
3946 (beginning-of-line)
3947 (setq arg -1) ;; Stop moving, yank back at current place.
3948 (goto-char old-point)))
3949 (setq arg -1)) ;; Stop moving, yank back at current place.
3950 (when (and (> arg 0)
3951 (string= (planner-task-plan current-task)
3952 (planner-task-plan (planner-current-task-info))))
3953 (setq task-seen (planner-current-task-info))))
3954 (setq arg (1- arg)))
3955 ;; Cursor now at right place
3956 (save-excursion (yank))
3957 ;; Update the linked page, if any
3958 (save-window-excursion
3959 (save-excursion
3960 (save-restriction
3961 (when (and task-seen
3962 (planner-task-link current-task)
3963 (planner-jump-to-linked-task current-task))
3964 (let ((old-task
3965 (buffer-substring
3966 (planner-line-beginning-position)
3967 (planner-line-end-position)))
3968 found)
3969 (save-excursion
3970 (save-restriction
3971 (when (planner-find-task task-seen)
3972 ;; Found the new task, so delete the old task and
3973 ;; insert here
3974 (setq found t)
3975 (insert old-task "\n"))))
3976 (when found
3977 (delete-region
3978 (planner-line-beginning-position)
3979 (1+ (planner-line-end-position)))))))))))
3981 (defun planner-lower-task (&optional arg)
3982 "Lower the number of the current task by ARG steps (default 1)."
3983 (interactive "p")
3984 (beginning-of-line)
3985 (setq arg (or arg 1)) ; ARG defaults to 1 if not specified
3986 (if (< arg 0) (planner-raise-task (- arg)))
3987 (let* ((current-task (planner-current-task-info))
3988 ;; task-seen will be the last task moved over with the same link
3989 task-seen)
3990 (unless current-task
3991 (error "Not on a task line"))
3992 ;; Store the current line in the kill ring, deleting it
3993 (kill-region (point) (1+ (planner-line-end-position)))
3994 ;; If the current line is not a task, search for the next block
3995 (while (> arg 0)
3996 (let ((old-point (point)))
3997 (if (not (planner-current-task-info))
3998 (if (re-search-forward "^#[ABC][0-9]*[ \t]" nil t)
3999 (planner-line-beginning-position)
4000 (setq arg -1) ;; Stop moving, yank back at current place.
4001 (goto-char old-point)))
4002 (when (and (> arg 0)
4003 (string= (planner-task-plan current-task)
4004 (planner-task-plan (planner-current-task-info))))
4005 (setq task-seen (planner-current-task-info))))
4006 (unless (and (> arg 0) (= (forward-line 1) 0))
4007 (setq arg -1))
4008 (setq arg (1- arg)))
4009 ;; Cursor now at right place
4010 (save-excursion (yank))
4011 ;; Update the linked page, if any
4012 (save-window-excursion
4013 (save-excursion
4014 (save-restriction
4015 (when (and task-seen
4016 (planner-task-link current-task)
4017 (planner-jump-to-linked-task current-task))
4018 (let ((old-task
4019 (buffer-substring
4020 (planner-line-beginning-position)
4021 (planner-line-end-position)))
4022 found)
4023 (save-excursion
4024 (save-restriction
4025 (when (planner-find-task task-seen)
4026 ;; Found the new task, so delete the old task and
4027 ;; insert here
4028 (setq found t)
4029 (forward-line 1)
4030 (insert old-task "\n"))))
4031 (when found
4032 (delete-region
4033 (planner-line-beginning-position)
4034 (1+ (planner-line-end-position)))))))))))
4036 ;;;_ + Changing the status
4038 (defvar planner-mark-task-hook nil
4039 "Hook called after a task's status has been changed.
4040 Arguments are OLD-STATUS and NEW-STATUS. Functions should leave
4041 the point on the task. If a function returns nil, no other
4042 functions will be processed.")
4044 (defun planner-mark-task (mark &optional this-only)
4045 "Change task status to MARK.
4046 If THIS-ONLY is non-nil, the linked planner page is not
4047 updated."
4048 (let ((case-fold-search nil)
4049 (info (planner-current-task-info)))
4050 (when info
4051 (with-planner-update-setup
4052 (goto-char (planner-line-beginning-position))
4053 (skip-chars-forward "^ \t" (planner-line-end-position))
4054 (skip-chars-forward " \t" (planner-line-end-position))
4055 (delete-char 1)
4056 (insert mark)
4057 (unless this-only
4058 (planner-update-task))
4059 (run-hook-with-args-until-failure
4060 'planner-mark-task-hook
4061 (planner-task-status info)
4062 mark)))))
4064 (defun planner-task-open ()
4065 "Mark the current task as open."
4066 (interactive)
4067 (planner-mark-task "_"))
4069 (defun planner-task-in-progress ()
4070 "Mark the current task as in progress."
4071 (interactive)
4072 (planner-mark-task "o"))
4074 (defun planner-task-done ()
4075 "Mark the current task as done."
4076 (interactive)
4077 (planner-mark-task "X"))
4079 (defun planner-task-cancelled ()
4080 "Mark the current task as cancelled."
4081 (interactive)
4082 (planner-mark-task "C"))
4084 (defun planner-task-delegated ()
4085 "Mark the current task as delegated."
4086 (interactive)
4087 (planner-mark-task "D"))
4089 (defun planner-task-pending ()
4090 "Mark the current task as pending."
4091 (interactive)
4092 (planner-mark-task "P"))
4094 ;;;_ + Extracting
4096 (defun planner-seek-next-unfinished-task ()
4097 "Move point to the next unfinished task on this page.
4098 Return nil if not found."
4099 (interactive)
4100 (re-search-forward "^#[A-C][0-9]*\\s-+[_oDP]\\s-+" nil t))
4102 (defun planner-list-tasks-with-status (status &optional pages)
4103 "Display all tasks that match the STATUS regular expression on all day pages.
4104 If PAGES is:
4105 t: check all pages
4106 nil: check all day pages
4107 regexp: search all pages whose filenames match the regexp
4108 list of page names: limit to those pages
4109 alist of page/filename: limit to those pages
4110 This could take a long time."
4111 (interactive (list (read-string "Status: ")))
4112 (set-buffer (get-buffer-create "*Planner Tasks*"))
4113 (erase-buffer)
4114 (let (tasks)
4115 (setq tasks (planner-extract-tasks
4116 (cond ((eq pages t)
4117 (planner-file-alist))
4118 ((eq pages nil)
4119 (planner-get-day-pages))
4120 ((not (listp pages))
4121 (let ((regexp pages))
4122 (setq pages nil)
4123 (dolist (page (planner-file-alist))
4124 (when (string-match regexp (cdr page))
4125 (setq pages (cons page pages)))))
4126 pages)
4127 (t pages))
4128 (lambda (item)
4129 (string-match status (planner-task-status item)))))
4130 (while tasks
4131 (insert
4132 (format "[[%s]] %s %s %s\n"
4133 (planner-task-page (car tasks))
4134 (planner-task-priority (car tasks))
4135 (planner-task-status (car tasks))
4136 (planner-task-description (car tasks))))
4137 (setq tasks (cdr tasks))))
4138 (planner-mode)
4139 (setq muse-current-project (muse-project planner-project))
4140 (goto-char (point-min))
4141 (pop-to-buffer (current-buffer)))
4143 (defun planner-list-unfinished-tasks (&optional pages)
4144 "Display all unfinished tasks on PAGES.
4145 The PAGES argument limits the pages to be checked in this manner:
4146 t: check all pages
4147 \"regexp\": search all pages whose filenames match \"regexp\"
4148 list of page names: limit to those pages
4149 alist of page/filenames: limit to those pages
4151 Called interactively, this function will search day pages by
4152 default. You can specify the start and end dates or leave them as
4153 nil to search all days. Calling this function with an interactive
4154 prefix will prompt for a regular expression to limit pages.
4155 Specify \".\" or leave this blank to include all pages."
4156 (interactive (list (if current-prefix-arg
4157 (read-string "Regexp: ")
4158 (let ((planner-expand-name-default "nil"))
4159 (planner-get-day-pages
4160 (planner-read-date "nil by default. Start")
4161 (planner-read-date "nil by default. End")
4162 t)))))
4163 (planner-list-tasks-with-status "[^XC\n]" pages))
4165 ;;;_ + Notes
4167 (defvar planner-search-notes-buffer "*Planner Search*"
4168 "Buffer for search results.")
4170 ;;;###autoload
4171 (defun planner-search-notes-with-body (regexp limit)
4172 "Return a buffer with all the notes returned by the query for REGEXP.
4173 If called with a prefix argument, prompt for LIMIT and search days on
4174 or after LIMIT. Display the body of the notes as well."
4175 (interactive (list (read-string "Regexp: ")
4176 (if current-prefix-arg
4177 (let ((planner-expand-name-favor-future-p nil))
4178 (planner-read-date)))))
4179 (planner-search-notes regexp limit t))
4181 ;;;###autoload
4182 (defun planner-search-notes (regexp limit &optional include-body)
4183 "Return a buffer with all the notes returned by the query for REGEXP.
4184 If called with a prefix argument, prompt for LIMIT and search days on
4185 or after LIMIT. If INCLUDE-BODY is non-nil, return the body as well."
4186 (interactive (list (read-string "Regexp: ")
4187 (if current-prefix-arg
4188 (let ((planner-expand-name-favor-future-p nil))
4189 (planner-read-date)))
4190 nil))
4191 (with-planner
4192 (let* ((case-fold-search t)
4193 (results (planner-search-notes-internal regexp limit include-body)))
4194 (if results
4195 (progn
4196 (set-buffer (get-buffer-create planner-search-notes-buffer))
4197 (setq buffer-read-only nil)
4198 (erase-buffer)
4199 (mapcar
4200 (if include-body
4201 (lambda (item)
4202 (insert "** "
4203 (planner-make-link (elt item 0) (elt item 1)) "\t"
4204 (elt item 3) "\n\n"))
4205 (lambda (item)
4206 (insert (planner-make-link (elt item 0) (elt item 1)) "\t"
4207 (elt item 2) "\n")))
4208 results)
4209 (planner-mode)
4210 (goto-char (point-min))
4211 (pop-to-buffer (current-buffer)))
4212 (message "No results found.")))))
4214 ;;;_ + Calendar
4216 (defun planner-calendar-insinuate ()
4217 "Hook Planner into Calendar.
4219 Adds special planner key bindings to `calendar-mode-map'.
4220 After this function is evaluated, you can use the following
4221 planner-related keybindings in `calendar-mode-map':
4223 n jump to the planner page for the current day.
4224 N display the planner page for the current day."
4225 (interactive)
4226 (require 'calendar)
4227 (add-hook 'calendar-move-hook
4228 (lambda ()
4229 (when planner-calendar-show-planner-files
4230 (planner-calendar-show))))
4231 (define-key calendar-mode-map "n" 'planner-calendar-goto)
4232 (define-key calendar-mode-map "N" 'planner-calendar-show))
4233 (defalias 'planner-insinuate-calendar 'planner-calendar-insinuate)
4235 (defvar planner-calendar-buffer-list nil "List of buffers opened by calendar.")
4237 (defun planner-kill-calendar-files ()
4238 "Remove planner files shown from Calendar."
4239 (interactive)
4240 (while planner-calendar-buffer-list
4241 (when (buffer-live-p (car planner-calendar-buffer-list))
4242 (with-current-buffer (car planner-calendar-buffer-list)
4243 (save-buffer)
4244 (planner-maybe-remove-file)))
4245 (setq planner-calendar-buffer-list (cdr planner-calendar-buffer-list))))
4247 ;;;###autoload
4248 (defun planner-calendar-goto ()
4249 "Goto the plan page corresponding to the calendar date."
4250 (interactive)
4251 (let ((planner-use-other-window t))
4252 (planner-goto (planner-date-to-filename (calendar-cursor-to-date)))))
4254 ;;;###autoload
4255 (defun planner-calendar-show ()
4256 "Show the plan page for the calendar date under point in another window."
4257 (interactive)
4258 (save-selected-window
4259 (let ((planner-use-other-window t)
4260 (date (planner-date-to-filename (calendar-cursor-to-date))))
4261 (if (planner-goto date planner-show-only-existing)
4262 (add-to-list 'planner-calendar-buffer-list (current-buffer))
4263 ;; Return nil or a message if there is no day plan page. planner-goto
4264 ;; is not called interactively, so it doesn't send a message.
4265 (when (interactive-p)
4266 (message "No planner file for %s" date))
4267 ;; return nil
4268 nil))))
4270 (defadvice exit-calendar (after planner activate protect)
4271 "Call `planner-kill-calendar-files'."
4272 (planner-kill-calendar-files))
4274 (defun planner-calendar-select ()
4275 "Return to `planner-read-date' with the date currently selected."
4276 (interactive)
4277 (when (calendar-cursor-to-date)
4278 (setq planner-calendar-selected-date
4279 (planner-date-to-filename (calendar-cursor-to-date)))
4280 (if (active-minibuffer-window) (exit-minibuffer))))
4282 ;;;_* Context-sensitive keybindings
4284 (defun planner-jump-to-link ()
4285 "Jump to the item linked to by the current item."
4286 (interactive)
4287 (cond
4288 ((planner-current-task-info) (planner-jump-to-linked-task))
4289 ((planner-current-note-info) (planner-jump-to-linked-note))))
4291 (defun planner-move-up ()
4292 "Move up.
4293 Task: Raise the number of the current task.
4294 Note: Renumbering does not make sense for notes right now, so go to the
4295 previous note.
4296 Headline: Go to previous headline of the same depth."
4297 (interactive)
4298 (cond
4299 ((planner-current-task-info) (planner-raise-task))
4300 ((planner-current-note-info)
4301 (re-search-backward "^\\.#[0-9]+" nil t))
4302 ((and (goto-char (planner-line-beginning-position))
4303 (looking-at "^\\*+"))
4304 (re-search-backward
4305 (concat "^" (regexp-quote (match-string 0)) "\\s-") nil t))))
4308 (defun planner-move-down ()
4309 "Move down.
4310 Task: Lower the number of the current task.
4311 Note: Renumbering does not make sense for notes right now, so go to the
4312 next note.
4313 Headline: Go to the next headline of the same depth."
4314 (interactive)
4315 (cond
4316 ((planner-current-task-info) (planner-lower-task))
4317 ((planner-current-note-info)
4318 (forward-line 1)
4319 (re-search-forward "^\\.#[0-9]+" nil t))
4320 ((and (goto-char (planner-line-beginning-position))
4321 (looking-at "^\\*+"))
4322 (forward-line 1)
4323 (re-search-forward
4324 (concat "^" (regexp-quote (match-string 0)) "\\s-") nil t))))
4326 ;;;_* Initialization
4328 (setq planner-loaded t)
4330 ;; Insinuate with allout mode
4331 (add-hook 'allout-mode-leaders '(planner-mode . "."))
4333 (provide 'planner)
4335 ;;;_* Local emacs vars.
4337 ;; Local variables:
4338 ;; allout-layout: (* 0 : )
4339 ;; End:
4341 ;;; planner.el ends here