1 ;;; planner.el --- The Emacs Planner
7 ;;;_ + Package description
9 ;; Copyright (C) 2001, 2003, 2004, 2005,
10 ;; 2006 Free Software Foundation, Inc.
11 ;; Parts copyright (C) 2004 David D. Smith (davidsmith AT acm DOT org)
12 ;; Parts copyright (C) 2004 Yvonne Thomson (yvonne AT netbrains DOT com DOT au)
13 ;; Parts copyright (C) 2004 Maciej Kalisak (mac AT cs DOT toronto DOT edu)
14 ;; Parts copyright (C) 2004 Chris Parsons (chris.p AT rsons.org)
15 ;; Parts copyright (C) 2004 Dirk Bernhardt (nospam AT krid.de)
16 ;; Parts copyright (C) 2005 Dryice Dong Liu
17 ;; Parts copyright (C) 2005 Angus Lees (gus AT debian.org)
18 ;; Parts copyright (C) 2005 Sergey Vlasov (vsu AT altlinux.ru)
19 ;; Parts copyright (C) 2005 Yann Hodique (hodique AT lifl DOT fr)
20 ;; Parts copyright (C) 2005 Peter K. Lee
22 ;; Emacs Lisp Archive Entry
23 ;; Filename: planner.el
25 ;; Keywords: hypermedia
26 ;; Author: John Wiegley <johnw@gnu.org>
27 ;; Maintainer: Michael Olson <mwolson@gnu.org>
28 ;; Description: Use Emacs for life planning
29 ;; URL: http://www.plannerlove.com/
30 ;; Bugs: https://gna.org/bugs/?group=planner-el
31 ;; Compatibility: Emacs20, Emacs21, Emacs22, XEmacs21
33 ;; This file is part of Planner. It is not part of GNU Emacs.
35 ;; Planner is free software; you can redistribute it and/or modify it
36 ;; under the terms of the GNU General Public License as published by
37 ;; the Free Software Foundation; either version 2, or (at your option)
40 ;; Planner is distributed in the hope that it will be useful, but
41 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
42 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
43 ;; General Public License for more details.
45 ;; You should have received a copy of the GNU General Public License
46 ;; along with Planner; see the file COPYING. If not, write to the
47 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
48 ;; Boston, MA 02110-1301, USA.
52 ;; Place planner.el in your load path and add this to your .emacs:
56 ;; By default and for backward compatibility, the following operations
57 ;; do not have keybindings, and are only accessible from the Planner
60 ;; planner-copy-or-move-region
61 ;; planner-delete-task
62 ;; planner-task-delegated
63 ;; planner-task-pending
66 ;; You may find it easier to install keybindings for those operations by
67 ;; inserting the following in your .emacs file:
69 ;; ;; Note: This changes some of the default key bindings for planner-mode
70 ;; (planner-install-extra-task-keybindings)
72 ;; If you want to change `planner-directory' and some other variables,
73 ;; either use Customize or use `setq'. For example:
75 ;; (setq planner-directory "~/Plans")
77 ;; You can customize Planner. M-x customize-group RET planner RET
78 ;; or see the Options section.
82 ;; This package extends Emacs Muse to act as a day planner, roughly
83 ;; equivalent to the one used by Franklin-Covey. If they have patents
84 ;; and trademarks and copyrights to prevent me even thinking in terms
85 ;; of their methodology, then I can't believe they care at all about
90 ;; * Make a planning file
92 ;; Open a wiki file within your planning directory. By default,
93 ;; planner-directory is set to "~/Plans". You may have to use C-x C-f
96 ;; A plan file generally describes a long-term plan. For example, you
97 ;; could make a plan file for your ThesisProject or your
98 ;; ContinuousLearning. Planner.el can help you organize related ideas,
99 ;; tasks and resources into a coherent plan.
101 ;; * Break your plan into stages
103 ;; Start the file with your "vision", or the goal you intend to
104 ;; accomplish. Break this up into parts, and create a Wiki file for
105 ;; each part, with defined milestones which constitute the "goal" for
108 ;; * Write out the tasks for each stage
110 ;; In each sub-plan, list out the tasks necessary to accomplish the
111 ;; milestone. Write them into the file like this:
113 ;; #A _ 1h Call so and so to make a reservation
115 ;; * Decide on a priority for each task
117 ;; The A is the priority of the task. The _ means it isn't done yet,
118 ;; and the 1h is a quick estimate on how long it will task. The time
119 ;; estimates are optional.
121 ;; The priorities break down like this:
123 ;; A: if you don't do it, your plan will be compromised, and you
124 ;; will have to either abort, backtrack, or make profuse apologies
127 ;; B: if you don't do it, your plan will be delayed
129 ;; C: the plan won't be complete until it's done, but there's no
130 ;; pressure to do it now
132 ;; * Schedule the tasks
134 ;; Put your cursor on a line containing a task, and type C-c C-c.
135 ;; This will copy the task to a specific day, which you will be
136 ;; prompted for. The Emacs Calendar pops up, so you can pick a free
137 ;; day (if you use the Emacs diary and appointment system, the
138 ;; Calendar is even more useful).
140 ;; You will now see your new task, with a link back to your planning
141 ;; page. Selecting this link will take you back to that task on the
142 ;; planning page, where you will see that the planning page's task now
143 ;; has a link to the particular day you scheduled the task for.
145 ;; The two tasks (the one on the planning page, and the one on the
146 ;; daily task list) are linked. Changing the status of one (using C-c
147 ;; C-x, or C-c C-s, for example) will change the status of the other.
148 ;; If you forward the task to another day (using C-c C-c on the daily
149 ;; task page), the planning page's link will be updated to refer to
150 ;; the new day. This is so that you can focus on your daily task list
151 ;; during the day, but see an overview of your plan's progress at any
156 ;; That's it, as far as what planner.el can do. As you complete tasks
157 ;; each day, they will disappear from view. This only happens for
158 ;; today's completed and forwarded tasks.
160 ;; Planning is an art, just as estimating time is an art. It happens
161 ;; with practice, and by thinking about these things. The Commentary
162 ;; below provides a few of my own thoughts on the matter, although I
163 ;; will say that this an art I have yet to truly develop.
165 ;; The `COMMENTARY' file has John Wiegley's original commentary.
167 ;;;_ + And now back to technical matters
169 ;; In order to refresh and renumber all of your tasks according to their
170 ;; actual order in the buffer, simply save the file or call
171 ;; M-x planner-fix-tasks .
173 ;; Here is a summary of the keystrokes available, including a few I
176 ;; M-x plan Begin your planning session. This goes to the last
177 ;; day for which there is any planning info (or today if
178 ;; none), allowing you to review, and create/move tasks
181 ;; C-M-p Raise a task's priority
182 ;; C-M-n Lower a task's priority
184 ;; C-c C-s Mark the task as in progress or delegated
185 ;; C-c C-x Mark the task as finished
187 ;; C-c C-t Create a task associated with the current Wiki page
188 ;; If you are on the opening line of a Note entry, it is
189 ;; assume that the note itself is the origin of the task.
190 ;; C-c C-c Move or copy the current task to another date
191 ;; If the current task is an original (meaning you are in
192 ;; the buffer where's defined, hopefully a planning page)
193 ;; then it will be copied, and the original task will also
194 ;; now point to the copy. If the current task is a copy,
195 ;; it will just be moved to the new day, and the original
196 ;; tasks link will be updated.
198 ;; C-c C-n Jump to today's task page
200 ;; If you call (planner-calendar-insinuate), typing 'n' in the Emacs
201 ;; calendar will jump to today's task page.
203 ;;;_ + Planning and schedules
205 ;; Sometimes you will have appointments during the day to schedule,
206 ;; which "block out" time that might otherwise be spent on tasks.
207 ;; Users are encouraged to use the Emacs Calendar for this, along with
208 ;; Diary Mode (see the Emacs manual)
211 ;; However, there is a way to do scheduling directly in planner-mode.
212 ;; It requires the external tool "remind" (Debian users type "apt-get
213 ;; install remind". All others go to
214 ;; http://www.roaringpenguin.com/penguin/open_source_remind.php)
216 ;; Once you have remind installed, you will need two scripts in your
217 ;; local bin directory (/usr/local/bin, $HOME/bin, wherever). These
218 ;; scripts can be downloaded from my web site:
220 ;; http://sacha.free.net.ph/notebook/emacs/plan2rem
221 ;; http://sacha.free.net.ph/notebook/emacs/rem2diary
225 ;; http://sacha.free.net.ph/notebook/emacs/remind.el
227 ;; and put it somewhere in your load path. Take a look at remind.el
228 ;; for more details. You will need to edit a few things to get it
231 ;; Lastly, here is another snippet for your .emacs file. It creates a
232 ;; keybinding in planner-mode, C-c C-w, which jumps you to the
233 ;; Schedule section of that file.
235 ;; (defun planner-goto-schedule ()
237 ;; (goto-char (point-min))
238 ;; (unless (re-search-forward "^\\* Schedule\n\n" nil t)
239 ;; (re-search-forward "^\\* Notes")
240 ;; (beginning-of-line)
241 ;; (insert "* Schedule\n\n\n\n")
242 ;; (forward-line -2)))
244 ;; (eval-after-load "planner"
246 ;; (define-key planner-mode-map [(control ?c) (control ?w)]
247 ;; 'planner-goto-schedule)))
249 ;; The contents of a scheduling section look like this, which is
250 ;; rendered in HTML as a table:
255 ;; 14:00 | Go to the dentist (2:00)
258 ;; The start time is given in 24-hour time, with an optional duration
259 ;; occuring in parentheses at the end of the description hs-show(in
260 ;; HOURS:MINUTES). And off you go!
262 ;; You can also organize this as
264 ;; 8:00 | 8:30 | Wake up
265 ;; 14:00 | 16:00 | Go to the dentist
266 ;; 18:00 | 21:00 | Watch TV
268 ;;;_ + Example planning file
270 ;; The format of a planning file is given below. You are responsible
271 ;; for keeping it looking like this. I intentionally did not make
272 ;; planner.el heavy on the UI side of things, too keep it more
273 ;; free-form and open. This lets you adapt it to whatever your
274 ;; particular preferences might be.
276 ;;----------------------------------------------------------------------
279 ;; #A1 _ An open task, very important!
280 ;; #A2 X A closed task (MyPlan)
281 ;; #A3 o A task that's delayed, or delegated (MyPlan)
285 ;; .#1 This is note number one
287 ;; Notes on note number one!
289 ;; .#2 This weird ".#2" syntax is used because it's what allout.el
290 ;; likes for enumerated lists, and it makes using
291 ;; outline-minor-mode (with allout) very handy. You can omit the
292 ;; leading period if you like, though. It's optional.
294 ;; ----------------------------------------------------------------------
296 ;;;_ + Other packages that come with the Planner distribution
298 ;; planner-bbdb.el | Link to your contacts
299 ;; planner-diary.el | Thomas Gehrlein's diary integration
300 ;; planner-gnus.el | Link to your mail/news messages
301 ;; planner-id.el | Automatically add unique task IDs
302 ;; planner-notes.el | Create a note index
303 ;; planner-rss.el | Publish your notes as an RSS feed
304 ;; planner-schedule.el | Estimate task completion time
305 ;; planner-timeclock.el | Clock in and clock out
306 ;; planner-w3m.el | Make tasks based on W3M buffers
307 ;; remember.el | Easily remember short notes
311 ;; A short, partial list of contributors, those who reported bugs, and
312 ;; those who gave valuable suggestions can be found at
313 ;; http://sacha.free.net.ph/notebook/wiki/PlannerMode.php
317 ;; David D. Smith (davidsmith AT acm DOT org) helped links to planner
318 ;; pages be created properly, among other things.
320 ;; Frederik Fouvry fixed a match error by using grouping.
322 ;; Daniel Neri (dne AT mayonnaise DOT net) fixed a couple of typos.
324 ;; Mario Peter (email address unknown) made
325 ;; `planner-in-progress-task-face' use :bold instead of :slant if
328 ;; Yvonne Thomson (yvonne AT netbrains DOT com DOT au) contributed
329 ;; `planner-annotation-from-info'.
331 ;; Hoan Ton-That (hoan AT ton-that DOT org) had the idea to strip the
332 ;; directory from planner file annotations and contributed the base
335 ;; Michael Olson (mwolson AT gnu DOT org) contributed XHTML 1.1
336 ;; patches, fixed some bugs that irked him, and did a few other
337 ;; miscellaneous things.
339 ;; Maciej Kalisiak (mac AT cs DOT toronto DOT edu) made a patch that
340 ;; sorts dated tasks before undated ones. Maciej also helped with the
341 ;; separation of the sorting and renumbering processes.
343 ;; Dale P. Smith (dsmich AT adelphia DOT net) contributed a small
344 ;; patch that fixes tasks that are not true wiki names.
346 ;; Stefan Reichör (stefan AT xsteve DOT at) contributed a small patch
347 ;; that saves only modified buffers, and some other patches as well.
349 ;; Chris Parsons made it so that C-u means put note on plan page.
351 ;; Dirk Bernhardt contributed a patch that added the
352 ;; `planner-default-tasks-status' option.
354 ;; Jim Ottaway provided several bugfixes.
356 ;; Dryice Dong Liu made the place to put the annotation in the task
357 ;; description configurable.
359 ;; Angus Lees provided a patch to make planner-sort-tasks stop causing
362 ;; Yann Hodique (hodique AT lifl DOT fr) fixed a number of problems
363 ;; with the Muse port of Planner.
365 ;; Peter K. Lee (saint AT corenova DOT com) fixed a few initial errors
366 ;; with missing and malformed functions like `planner-page-exists-p'
367 ;; and `planner-option-customized'
369 ;; Romain Francoise improved match data handling in
370 ;; `planner-browse-position-url'.
372 ;; Win Treese fixed a bug in `planner-save-buffers'.
374 ;; Sven Kloppenburg fixed a regexp.
376 ;; Sergey Vlasov fixed several bugs.
378 ;; Marco Gidde provided a patch that allows Planner to visit a link to
379 ;; a temporary file by visiting its buffer.
381 ;; Trent Buck made things work better when day pages are disabled.
383 ;; Andrew J. Korty made it so that task padding is only used if
384 ;; `planner-use-task-numbers' is non-nil.
390 (require 'muse-colors
)
392 (require 'muse-project
)
400 (when (featurep 'xemacs
)
404 (defvar planner-loaded nil
)
405 (defvar planner-version
"3.40"
406 "The version of Planner currently loaded.")
408 ;; Compatibility hacks -- these will be removed in the future
410 (defun planner-update-wiki-project ()
413 (defvar planner-markup-tags nil
)
415 (defun planner-option-customized (sym val
)
416 "Set SYM to VAL and update the WikiPlanner project."
419 (planner-update-wiki-project)))
423 (defgroup planner nil
424 "A personal information manager for Emacs."
426 :group
'applications
)
428 (defcustom planner-project
"WikiPlanner"
429 "The name of this project in `muse-project-alist'."
433 (defcustom planner-initial-page
"WelcomePage"
434 "The name of the root plan page that `plan' will find when not
435 using day pages. If you are using day pages (the default), this
440 (defcustom planner-publish-dates-first-p nil
441 "Non-nil means put day pages at the top of the index."
445 (defcustom planner-use-day-pages t
446 "If non-nil, allow the use of day pages.
447 You can set this to nil if you use plan pages exclusively and
448 don't want to be prompted for dates. If so, then `plan' will
449 bring up the `planner-initial-page' of your planner wiki."
453 (defcustom planner-use-plan-pages t
454 "If non-nil, allow the use of plan pages.
455 You can set this to nil if you use day pages exclusively and
456 don't want to be prompted for plans."
460 (defcustom planner-mode-hook nil
461 "A hook for Planner mode."
465 (defcustom planner-annotation-functions
466 '(planner-annotation-from-planner-note
467 planner-annotation-from-planner
468 planner-annotation-from-wiki
469 planner-annotation-from-dired
470 planner-annotation-from-file-with-position
)
471 "Functions tried in order by `planner-create-task-from-buffer'.
472 To change the behavior of `planner-create-task-from-buffer',
473 remove, change the order of, or insert functions in this list."
477 (defcustom planner-annotation-symbol-string
"{}"
478 "The string to be replaced by annotation from `planner-annotation-functions'.
479 If nil or not found in the task title, the annotation will be
484 (defcustom planner-use-other-window t
485 "If non-nil, Planner will open planner files in another window."
489 (defcustom planner-show-only-existing t
490 "If non-nil, `planner-show' only shows existing files."
494 (defcustom planner-reverse-chronological-notes t
495 "*If non-nil, notes are added to the beginning of the section."
499 (defcustom planner-create-section-function
'planner-create-at-top
500 "Called when creating a new section.
501 Some functions you can use are `planner-create-at-top' and
502 `planner-create-at-bottom'."
506 (defcustom planner-template-fuzz-factor
5
507 "Controls the fuzziness of `planner-page-default-p'.
508 Right now, this is the number of additional characters over
509 `planner-day-page-template' allowed in a buffer before
510 `planner-page-default-p' assumes it has been modified."
514 (defcustom planner-calendar-show-planner-files t
515 "If non-nil, shows a plan file every time a day is selected in Calendar."
519 (defcustom planner-day-page-template
520 "* Tasks\n\n\n* Schedule\n\n\n* Notes\n\n\n"
521 "Template to be inserted into blank daily pages.
522 If this is a string, it will be inserted into the blank page. If
523 this is a function, it will be called with no arguments from a
524 blank planner page and should insert the template.
526 If you want to change the name of special sections like Tasks and Notes,
527 update the `planner-sections' option as well."
529 (string :tag
"Template")
530 (function :tag
"Function"))
533 (defcustom planner-plan-page-template
"* Tasks\n\n\n* Notes\n\n\n"
534 "Template to be inserted into blank plan pages.
535 If this is a string, it will be inserted into the blank page. If
536 this is a function, it will be called with no arguments from a
537 blank planner page and should insert the template.
539 If you want to change the name of special sections like Tasks and Notes,
540 update the `planner-sections' option as well."
542 (string :tag
"Template")
543 (function :tag
"Function"))
546 (defcustom planner-default-section
'tasks
547 "Default section when you use `planner-goto' to open a page.
548 If this is a string, it should be a section name. If this is a symbol,
549 the section name is looked up in `planner-sections'."
550 :type
'(choice (string :tag
"String")
551 (symbol :tag
"Symbol"))
554 (defcustom planner-sections
'((tasks .
"Tasks")
556 "Special sections in pages.
557 This option makes it easier to change the names of your sections
558 without modifying a lot of Planner code. If you change this, you
559 may also want to change `planner-day-page-template' and
560 `planner-plan-page-template'. You normally don't need to change
562 :type
'(alist :key symbol
:value string
)
565 (defcustom planner-ignored-from-addresses
566 (and user-mail-address
567 (not (string= user-mail-address
""))
568 (regexp-quote user-mail-address
))
569 "Regexp of From headers that may be suppressed in favor of To headers."
573 (defcustom planner-dates-relative-to-today-flag nil
574 "Non-nil means relative dates (+1, -1) are always based on today.
575 By default, dates are based on the current page."
579 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
581 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583 (defgroup planner-tasks nil
584 "Planner options related to tasks."
588 (defcustom planner-carry-tasks-forward
3
589 "If non-nil, carry unfinished tasks forward automatically.
590 If a positive integer, scan that number of days in the past.
591 If 0, scan all days for unfinished tasks.
592 If t, scan one day in the past (old behavior).
593 If nil, do not carry unfinished tasks forward."
595 (const :tag
"Scan all days" 0)
596 (const :tag
"Scan most recent day" t
)
597 (const :tag
"Do not carry tasks forward" nil
)
598 (integer :tag
"Number of days to scan"))
599 :group
'planner-tasks
)
601 (defcustom planner-marks-regexp
"[_oXDCP]"
602 "Regexp that matches status character for a task."
604 :group
'planner-tasks
)
606 (defcustom planner-default-task-priority
"B"
607 "Default priority for new tasks created with `planner-create-task'."
609 :group
'planner-tasks
)
611 (defcustom planner-default-task-status
"_"
612 "Default status for new tasks created with `planner-create-task'."
614 :group
'planner-tasks
)
616 (defcustom planner-add-task-at-end-flag nil
617 "*Non-nil means create tasks at the bottom of the first task block."
618 :group
'planner-tasks
626 (defvar planner-mode-map
627 (let ((map (make-sparse-keymap)))
631 (set-keymap-parents map muse-mode-map
))
633 ((fboundp 'set-keymap-parent
)
634 (set-keymap-parent map muse-mode-map
))
635 ;; if we can't inherit the keymap, copy it instead
636 (t (setq map
(copy-keymap muse-mode-map
))))
637 (define-key map
"\C-c\C-n" 'planner-goto-today
)
638 ;; moving between daily pages C-c C-j for goto (used to be C-g,
639 ;; but that was confusing)
640 (define-key map
"\C-c\C-j\C-d" 'planner-goto
) ; goto date
641 (when planner-use-day-pages
642 (define-key map
"\C-c\C-j\C-p" 'planner-goto-previous-daily-page
)
643 (define-key map
"\C-c\C-j\C-n" 'planner-goto-next-daily-page
)
644 (define-key map
"\C-c\C-j\C-j" 'planner-goto-today
) ; for easy typing
645 (define-key map
"\C-c\C-j\C-y" 'planner-goto-yesterday
)
646 (define-key map
"\C-c\C-j\C-t" 'planner-goto-tomorrow
)
647 (define-key map
"\C-c\C-j\C-r" 'planner-goto-most-recent
)) ; recent
649 (define-key map
"\C-c\C-t" 'planner-create-task-from-buffer
)
650 (define-key map
"\C-c\C-c" 'planner-copy-or-move-task
)
651 (define-key map
"\C-c\C-u" 'planner-raise-task
)
652 (define-key map
"\C-c\C-d" 'planner-lower-task
)
654 (define-key map
"\M-p" 'planner-raise-task
)
655 (define-key map
"\M-n" 'planner-lower-task
)
657 (define-key map
"\M-\C-p" 'planner-raise-task-priority
)
658 (define-key map
"\M-\C-n" 'planner-lower-task-priority
)
660 (define-key map
"\C-c\C-z" 'planner-task-in-progress
)
661 (define-key map
"\C-c\C-x" 'planner-task-done
)
662 (define-key map
'[(control ?c
) (control ?X
)] 'planner-task-cancelled
)
664 "Keymap used by Planner mode.")
666 (defun planner-install-extra-context-keybindings ()
667 "Install extra context-sensitive keybindings.
668 These keybindings conflict with windmove.el, but might
671 On a task or note, the following keys will move around:
673 Shift-up: `planner-move-up'
674 Shift-down: `planner-move-down'
675 Shift-right: `planner-jump-to-link'"
677 (let ((map planner-mode-map
))
678 (define-key map
[(shift up
)] 'planner-move-up
)
679 (define-key map
[(shift down
)] 'planner-move-down
)
680 (define-key map
[(shift right
)] 'planner-jump-to-link
)))
682 ;;; Additional keybindings thanks to Thomas Gehrlein
684 (defun planner-install-extra-task-keybindings ()
685 "Install additional task key bindings.
686 Warning! Overwrites some standard key bindings. See function
687 definition for keys added."
688 (let ((map planner-mode-map
))
689 (define-key map
"\C-c\C-t" nil
)
690 (define-key map
"\C-c\C-t\C-t" 'planner-create-task-from-buffer
)
691 (define-key map
"\C-c\C-t\C-k" 'planner-delete-task
)
692 (define-key map
"\C-c\C-t\C-u" 'planner-update-task
)
693 (define-key map
"\C-c\C-t\C-c" 'planner-copy-or-move-task
)
694 (define-key map
'[(control ?c
) (control ?t
) (control ?C
)]
695 'planner-copy-or-move-region
)
696 (define-key map
"\C-c\C-t\C-x" 'planner-task-done
)
697 (define-key map
'[(control ?c
) (control ?t
) (control ?X
)]
698 'planner-task-cancelled
)
699 (define-key map
"\C-c\C-t\C-d" 'planner-task-delegated
)
700 (define-key map
"\C-c\C-t\C-p" 'planner-task-pending
)
701 (define-key map
"\C-c\C-t\C-o" 'planner-task-in-progress
)
702 (define-key map
"\C-c\C-t\C-r" 'planner-raise-task
)
703 (define-key map
"\C-c\C-t\C-l" 'planner-lower-task
)
704 (define-key map
"\C-c\C-t\C-n" 'planner-fix-tasks
)))
706 ;;; We need some keybindings for note-related functions, too
708 (defun planner-install-extra-note-keybindings ()
709 "Install additional note-related key bindings.
710 See function definition for keys added."
711 (let ((map planner-mode-map
))
712 (define-key map
"\C-c\C-o" nil
)
713 (define-key map
"\C-c\C-o\C-o" 'planner-create-note
)
714 (define-key map
"\C-c\C-o\C-s" 'planner-search-notes
)
715 (define-key map
"\C-c\C-o\C-b" 'planner-search-notes-with-body
)
716 (define-key map
"\C-c\C-o\C-n" 'planner-renumber-notes
)))
720 ;;; Menu thanks to Thomas Gehrlein
721 (easy-menu-define planner-menu planner-mode-map
722 "Menu of planner mode.
723 See `planner-install-extra-task-keybindings' for additional bindings
727 ;; moving between day plan pages
728 (if planner-use-day-pages
730 ["Plan page" planner-goto-plan-page
]
731 ["Date" planner-goto
]
732 ["Previous page" planner-goto-previous-daily-page
]
733 ["Next page" planner-goto-next-daily-page
]
734 ["Today" planner-goto-today
]
735 ;; do the next two make sense in a menu?
736 ["Yesterday" planner-goto-yesterday
]
737 ["Tomorrow" planner-goto-tomorrow
]
738 ["Most recent" planner-goto-most-recent
])
739 '["Goto plan page" planner-goto-plan-page
])
742 ["Create" planner-create-task-from-buffer
]
743 ["Create from note" planner-create-task-from-note
]
744 ["Delete" planner-delete-task
]
745 ["Update" planner-update-task
]
746 ["Copy or move task" planner-copy-or-move-task
]
747 ["Copy or move region" planner-copy-or-move-region
]
749 ;; Roughly arranged by frequency, not by chronological sequence
750 ["Mark \"done\"" planner-task-done
]
751 ["Mark \"delegated\"" planner-task-delegated
]
752 ["Mark \"pending\"" planner-task-pending
]
753 ["Mark \"in progress\"" planner-task-in-progress
]
754 ["Mark \"cancelled\"" planner-task-cancelled
]
755 ["Mark \"open\"" planner-task-open
]
757 ["Raise task priority" planner-raise-task-priority
]
758 ["Lower task priority" planner-lower-task-priority
]
759 ["Format tasks nicely" planner-fix-tasks
])
762 ["Create" planner-create-note
]
763 ["Create from task" planner-create-note-from-task
]
765 ["Search" planner-search-notes
]
766 ["Search with body" planner-search-notes-with-body
]
767 ["Renumber" planner-renumber-notes
])
772 ;; help/info (now that we have a manual, use it)
773 '["Info manual" (info "planner-el")]))
775 ;;;_* Internal functions
779 ;;;_ + Emacs vs XEmacs
782 (defun planner-derived-mode-p (&rest modes
)
783 "Non-nil if the current major mode is derived from one of MODES.
784 Uses the `derived-mode-parent' property of the symbol to trace backwards."
785 (if (fboundp 'derived-mode-p
)
786 (apply 'derived-mode-p modes
)
787 ;; PUBLIC: find if the current mode derives from another.
788 ;; Taken from GNU Emacs 21 subr.el
789 (let ((parent major-mode
))
790 (while (and (not (memq parent modes
))
791 (setq parent
(get parent
'derived-mode-parent
))))
794 (defalias 'planner-match-string-no-properties
'muse-match-string-no-properties
)
795 (defalias 'planner-replace-regexp-in-string
'muse-replace-regexp-in-string
)
796 (defalias 'planner-line-beginning-position
'muse-line-beginning-position
)
797 (defalias 'planner-line-end-position
'muse-line-end-position
)
799 ;;; Copied from subr.el
800 (defun planner-copy-overlay (o)
801 "Return a copy of overlay O."
802 (if (fboundp 'copy-overlay
)
804 (let ((o1 (make-overlay (overlay-start o
) (overlay-end o
)
805 ;; FIXME: there's no easy way to find the
806 ;; insertion-type of the two markers.
808 (props (overlay-properties o
)))
810 (overlay-put o1
(pop props
) (pop props
)))
813 ;;; Copied from subr.el
814 (defun planner-remove-overlays (beg end name val
)
815 "Clear BEG and END of overlays whose property NAME has value VAL.
816 Overlays might be moved and or split."
817 (if (fboundp 'remove-overlays
)
818 (remove-overlays beg end name val
)
820 (setq beg
(prog1 end
(setq end beg
))))
822 (dolist (o (overlays-in beg end
))
823 (when (eq (overlay-get o name
) val
)
824 ;; Either push this overlay outside beg...end
825 ;; or split it to exclude beg...end
826 ;; or delete it entirely (if it is contained in beg...end).
827 (if (< (overlay-start o
) beg
)
828 (if (> (overlay-end o
) end
)
830 (move-overlay (planner-copy-overlay o
)
831 (overlay-start o
) beg
)
832 (move-overlay o end
(overlay-end o
)))
833 (move-overlay o
(overlay-start o
) beg
))
834 (if (> (overlay-end o
) end
)
835 (move-overlay o end
(overlay-end o
))
836 (delete-overlay o
))))))))
838 ;; Provide a simpler replacement for `remove-if-not'
839 (defun planner-remove-if-not (predicate seq
)
840 "Remove all items not satisfying PREDICATE in SEQ.
841 This is a non-destructive function; it makes a copy of SEQ to
842 avoid corrupting the original SEQ."
845 (when (funcall predicate el
)
846 (setq newseq
(cons el newseq
))))
850 (defun planner-display-warning (message)
851 "Display the given MESSAGE as a warning."
852 (if (fboundp 'display-warning
)
853 (display-warning 'planner message
854 (if (featurep 'xemacs
)
857 (let ((buf (get-buffer-create "*Planner warnings*")))
858 (with-current-buffer buf
859 (goto-char (point-max))
860 (insert "Warning (planner): " message
)
866 (defun planner-unhighlight-region (begin end
&optional verbose
)
867 "Remove all visual highlights in the buffer (except font-lock)."
868 (planner-zap-overlays begin end
)
869 (muse-unhighlight-region begin end verbose
))
871 (defun planner-zap-overlays (beg end
&optional verbose
)
872 "Remove all the planner-related overlays/extents from BEG to END."
873 (if (featurep 'xemacs
)
874 (mapcar-extents 'delete-extent nil nil beg end nil
'planner t
)
875 (planner-remove-overlays beg end
'planner t
)))
877 (defmacro with-planner
(&rest body
)
878 "Make sure BODY is evaluated in a `planner-mode' buffer."
879 `(if (planner-derived-mode-p 'planner-mode
)
882 (setq muse-current-project
(muse-project planner-project
))
883 (muse-project-set-variables)
886 (put 'with-planner
'lisp-indent-function
0)
887 (put 'with-planner
'edebug-form-spec
'(body))
889 ;; Use a macro for the setup around planner-update-task so
890 ;; the same setup can be used in planner-multi.el
891 (defmacro with-planner-update-setup
(&rest body
)
892 "Execute BODY then save buffers according to `planner-tasks-file-behavior'.
893 Also sets some variables to modify font-lock behaviour while updating."
894 (let ((live-buffers (make-symbol "live-buffers")))
895 `(save-window-excursion
898 (let ((,live-buffers
(and (eq planner-tasks-file-behavior
901 (current-buffer (current-buffer)))
903 (let ((planner-tasks-file-behavior nil
))
905 (when planner-tasks-file-behavior
906 (planner-save-buffers ,live-buffers t current-buffer
)))))))))
908 ;; Manually expanded def-edebug-spec so that we don't have to pull
910 (put 'with-planner-update-setup
'edebug-form-spec
'(body))
912 (defalias 'planner-current-file
'muse-current-file
)
914 (defun planner-file-alist (&optional no-check-p pages
)
915 "Return possible Wiki filenames in `planner-project'.
916 On UNIX, this list is only updated if one of the directories'
917 contents have changed or NO-CHECK-P is non-nil. On Windows, it is
918 always reread from disk.
920 (muse-project-file-alist planner-project no-check-p
))
922 (defun planner-find-file (wiki &optional command directory
)
923 "Open the Planner page WIKI by name.
924 If COMMAND is non-nil, it is the function used to visit the file.
925 If DIRECTORY is non-nil, it is the directory in which the Wiki
926 page will be created if it does not already exist."
927 (muse-project-find-file (planner-link-base wiki
)
932 (defalias 'planner-page-name
'muse-page-name
)
934 (defun planner-link-base (link)
935 "Return the page or URL named by LINK."
936 (when (string-match muse-explicit-link-regexp link
)
937 (setq link
(planner-match-string-no-properties 1 link
)))
938 (when (string-match "#" link
)
939 (setq link
(substring link
0 (match-beginning 0))))
942 (defalias 'planner-time-less-p
'muse-time-less-p
)
943 (defalias 'planner-private-p
'muse-project-private-p
)
944 (defalias 'planner-follow-name-at-point
'muse-follow-name-at-point
)
945 (defalias 'planner-next-reference
'muse-next-reference
)
946 (defalias 'planner-previous-reference
'muse-previous-reference
)
948 ;; FIXME: Code that uses `planner-directory' should be changed to deal
949 ;; with multiple directories.
950 (defun planner-directory ()
951 (car (cadr (muse-project planner-project
))))
953 (defun planner-published-file (file &optional output-dir style
)
955 (setq output-dir
(and muse-publishing-current-output-path
957 muse-publishing-current-output-path
))))
959 (muse-publish-output-file file output-dir style
)))
961 (defun planner-remove-links (description)
962 "Remove explicit links from DESCRIPTION."
964 (while (setq start
(string-match muse-explicit-link-regexp description
967 (replace-match (or (match-string 2 description
)
968 (match-string 1 description
))
972 (defun planner-make-link (link &optional name single
)
973 "Return a Wiki link to LINK with NAME as the text.
974 If SINGLE is non-nil, treat it as a single link.
975 If LINK is already a valid link, replace it's description
977 (cond ((or (null link
) (string= link
""))
979 ((string-match muse-explicit-link-regexp link
)
980 (muse-make-link (match-string 1 link
) name
))
982 (muse-make-link link name
))))
986 ;; In here instead of planner-diary because planner-appt and
987 ;; planner-cyclic use it as well. Contributions from Sergey Vlasov.
988 (defun planner-list-diary-entries (file date
&optional number
)
989 "Get list of diary entries in FILE for NUMBER days starting with DATE.
990 The list has the same form as returned by `list-diary-entries', but
991 this function tries to undo the changes which `list-diary-entries'
992 does to the diary buffer."
994 ;; The code to restore the buffer is copied from `include-other-diary-files'
995 (save-window-excursion
997 (let* ((diary-file file
)
998 (list-diary-entries-hook '(include-other-diary-files))
999 (diary-display-hook 'ignore
)
1001 (d-buffer (find-buffer-visiting diary-file
))
1002 (diary-modified (when d-buffer
1003 (set-buffer d-buffer
)
1004 (buffer-modified-p))))
1006 (list-diary-entries date
(or number
1))
1007 (let ((d-buffer (find-buffer-visiting diary-file
)))
1009 (set-buffer d-buffer
)
1010 (subst-char-in-region (point-min) (point-max) ?\^M ?
\n t
)
1011 (setq selective-display nil
)
1012 (set-buffer-modified-p diary-modified
))))))))
1016 (defcustom planner-align-tasks-automatically t
1017 "Non-nil means align tasks whenever a planner file is saved."
1020 (defcustom planner-sort-tasks-automatically t
1021 "Non-nil means sort tasks whenever a planner file is saved."
1024 (defcustom planner-renumber-tasks-automatically nil
1025 "Non-nil means renumber tasks whenever a planner file is saved."
1028 (defcustom planner-renumber-notes-automatically nil
1029 "Non-nil means renumber notes whenever a planner file is saved."
1035 (define-derived-mode planner-mode muse-mode
"Planner"
1036 "A personal information manager for Emacs.
1037 \\{planner-mode-map}"
1038 ;; because we're not inheriting from normal-mode, we need to
1039 ;; explicitly run file variables if the user wants to
1041 (hack-local-variables)
1042 (error (message "File local-variables error: %s"
1043 (prin1-to-string err
))))
1044 ;; check to see if the mode changed
1045 (when (eq major-mode
'planner-mode
)
1046 (let ((hook (if (boundp 'write-file-functions
)
1047 'write-file-functions
1048 'write-file-hooks
)))
1049 (add-hook hook
'planner-renumber-notes-maybe t t
)
1050 (add-hook hook
'planner-sort-tasks-maybe t t
)
1051 (add-hook hook
'planner-renumber-tasks-maybe t t
)
1052 (add-hook hook
'planner-align-tasks-maybe t t
))
1053 (planner-setup-highlighting)
1054 (when (fboundp 'easy-menu-add
)
1055 (easy-menu-add planner-menu planner-mode-map
))
1056 (planner-prepare-file)))
1057 ;; (when (and font-lock-mode muse-mode-highlight-p)
1058 ;; (muse-colors-buffer))))
1060 (defvar planner-date-regexp
1061 "\\<\\([1-9][0-9][0-9][0-9]\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\>")
1063 (defun planner-setup-highlighting ()
1064 "Set up fontification for planner."
1065 (add-hook 'muse-colors-buffer-hook
'planner-zap-overlays t t
)
1066 (add-hook 'muse-colors-buffer-hook
'planner-highlight-tasks t t
)
1067 (add-hook 'muse-colors-buffer-hook
'planner-highlight-notes t t
)
1068 (add-to-list 'muse-colors-markup
1069 (list planner-date-regexp t
'muse-colors-implicit-link
)
1071 (muse-configure-highlighting 'muse-colors-markup muse-colors-markup
)
1072 (set (make-local-variable 'font-lock-unfontify-region-function
)
1073 'planner-unhighlight-region
)
1074 (set (make-local-variable 'font-lock-defaults
)
1075 `(nil t nil nil
'beginning-of-line
1076 (font-lock-fontify-region-function . muse-colors-region
)
1077 (font-lock-unfontify-region-function
1078 . planner-unhighlight-region
))))
1080 (defun planner-muse-handle-date-link (&optional string
)
1081 "If STRING or point has a date, match and return it."
1083 (string-match planner-date-regexp string
)
1084 (looking-at planner-date-regexp
))
1085 (match-string 0 string
)))
1087 (custom-add-option 'muse-implicit-link-functions
1088 'planner-muse-handle-date-link
)
1089 (add-hook 'muse-implicit-link-functions
'planner-muse-handle-date-link t
)
1093 (defun planner-strip-whitespace (string)
1094 "Remove all whitespace from STRING. Return the modified string."
1097 (goto-char (point-min))
1098 (while (re-search-forward "[\r\n\t ]+" nil t
)
1102 (defun planner-page-default-p (&optional buffer
)
1103 "Return t if this plan page can be safely deleted.
1104 If the contents of this plan page are the same as the value of
1105 `planner-day-page-template' or the plan page is empty, then no
1106 information has been added and the page can safely be removed.
1108 If BUFFER is given, considers the planner page in BUFFER instead.
1110 Override this if `planner-day-page-template' is a function
1111 instead of a string."
1112 (with-current-buffer (or buffer
(current-buffer))
1113 (when (and (stringp planner-day-page-template
)
1114 (not (> (buffer-size)
1115 (+ (length planner-day-page-template
)
1116 planner-template-fuzz-factor
))))
1117 (let ((body (planner-strip-whitespace (buffer-string))))
1118 (or (= (length body
) 0)
1119 (string= body
(planner-strip-whitespace
1120 planner-day-page-template
)))))))
1122 (defvar planner-delete-file-function
'delete-file
1123 "Function called to remove a planner file from the current wiki.")
1125 (defun planner-maybe-remove-file ()
1126 "Delete the planner file if it does not contain new information."
1127 (if (planner-page-default-p (current-buffer))
1128 (let ((filename buffer-file-name
))
1129 (set-buffer-modified-p nil
)
1130 (kill-buffer (current-buffer))
1131 (when (file-exists-p filename
)
1132 (funcall planner-delete-file-function filename
)))
1133 (kill-buffer (current-buffer))))
1135 (defun planner-prepare-file ()
1136 "Insert some standard sections into an empty planner file."
1137 (when (= (buffer-size) 0)
1139 (if (and (planner-page-name)
1140 (string-match planner-date-regexp
(planner-page-name)))
1141 planner-day-page-template
1142 planner-plan-page-template
)))
1143 (if (functionp template
)
1146 (set-buffer-modified-p nil
))))
1148 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1151 (defun planner-link-href (url name
)
1152 "Return an href string for URL and NAME."
1153 (muse-publish-url url name
))
1155 (defun planner-link-target (link)
1156 "Return the URL or page in LINK."
1157 (if (string-match muse-explicit-link-regexp link
)
1158 (planner-match-string-no-properties 1 link
)
1161 (defun planner-link-name (link)
1162 "Return the name for LINK."
1163 (if (string-match muse-explicit-link-regexp link
)
1164 (planner-match-string-no-properties 2 link
)
1167 (defun planner-link-anchor (link)
1168 "Return the anchor part of LINK."
1169 (setq link
(planner-link-target link
))
1170 (if (string-match "#" link
)
1171 (substring link
(1+ (match-beginning 0)))))
1173 (defun planner-visit-link (link &optional other-window
)
1174 "Visit the URL or link named by LINK.
1175 REFRESH-BUFFER is an optional buffer to refresh on saving the visited page.
1176 This makes the bad link face in the linking buffer go away."
1177 (if (string-match muse-url-regexp link
)
1178 (muse-browse-url link
)
1179 (setq link
(planner-link-target link
))
1180 (let ((tag (planner-link-anchor link
))
1182 ;; use match data from planner-link-anchor
1184 (setq link
(if (= (match-beginning 0) 0)
1185 ;; If there is an anchor but no link, default
1186 ;; to the current page.
1188 (substring link
0 (match-beginning 0)))))
1190 (setq base-buffer
(get-buffer link
))
1191 (if (and base-buffer
(not (buffer-file-name base-buffer
)))
1192 ;; If file is temporary (no associated file), just switch to
1195 (switch-to-buffer-other-window base-buffer
)
1196 (switch-to-buffer base-buffer
))
1197 (let ((project (muse-project-of-file)))
1199 (muse-project-find-file link project
1201 'find-file-other-window
))
1203 (find-file-other-window link
)
1204 (find-file link
))))))
1206 (goto-char (point-min))
1207 (or (re-search-forward (concat "^\\.?#" (regexp-quote tag
) "\\>")
1209 (when (string-match "^anchor-\\(.*\\)" tag
)
1211 (concat "^\\.?#" (regexp-quote (match-string 1 tag
)) "\\>")
1214 (defalias 'planner-add-protocol
'muse-protocol-add
)
1215 (defalias 'planner-page-exists-p
'planner-page-file
)
1217 (defun planner-local-page-p (link)
1218 "Return non-nil if LINK seems to belong to the current wiki."
1220 (not (or (string-match ":\\|/"
1221 (planner-link-base link
))))))
1223 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1224 (defun planner-list-daily-files (&optional exclude-temp
)
1225 "Return an unsorted list of daily files.
1226 If EXCLUDE-TEMP is non-nil, ignore unsaved buffers."
1227 ;; get a list of all files
1228 ;; (save-some-buffers t (lambda () (equal 'planner-mode major-mode)))
1229 (let ((buffers (buffer-list))
1231 (mapcar (lambda (item)
1232 (when (string-match planner-date-regexp
(car item
))
1233 (setq files
(cons item files
))))
1234 (planner-file-alist))
1235 (unless exclude-temp
1237 (with-current-buffer (car buffers
)
1238 (when (and (equal 'planner-mode major-mode
)
1240 (string-match planner-date-regexp
(planner-page-name)))
1241 (unless (assoc (planner-page-name) files
)
1242 (add-to-list 'files
(cons (planner-page-name)
1243 (buffer-file-name))))))
1244 (setq buffers
(cdr buffers
))))
1247 (defun planner-get-day-pages (&optional from to exclude-temp
)
1248 "Return a descending list of day pages from FROM to TO (inclusive).
1249 If EXCLUDE-TEMP is non-nil, ignore unsaved pages."
1255 (string-match planner-date-regexp
(car item
))
1257 (string-lessp from
(car item
))
1258 (equal from
(car item
)))
1260 (string-lessp (car item
) to
)
1261 (equal (car item
) to
))
1263 (planner-list-daily-files exclude-temp
)))
1265 (string-lessp (car r
) (car l
)))))
1269 (defvar planner-calendar-selected-date nil
1270 "Temporary storage for date selected from calendar.")
1272 (defvar planner-use-calendar-flag t
1273 "*If non-nil, show calendar popup when reading a date.")
1275 (defun planner-read-date (&optional prompt force-read
)
1276 "Prompt for a date string in the minibuffer.
1277 If PROMPT is non-nil, display it as the prompt string.
1278 If FORCE-READ is non-nil, prompt for a date even when we are not
1280 (save-window-excursion
1281 (when (or planner-use-day-pages force-read
)
1282 (let ((old-buffer (current-buffer)))
1283 (when planner-use-calendar-flag
(calendar))
1284 (let ((old-map (copy-keymap calendar-mode-map
)))
1287 (define-key calendar-mode-map
[return]
1288 'planner-calendar-select)
1289 (define-key calendar-mode-map [mouse-1]
1290 'planner-calendar-select)
1291 (setq planner-calendar-selected-date nil)
1292 (let ((text (read-string
1296 "(%Y.%m.%d, %m.%d, %d): ")))))
1297 (or planner-calendar-selected-date
1298 (with-current-buffer old-buffer
1299 (planner-expand-name text)))))
1300 (setq calendar-mode-map old-map)))))))
1302 (defvar planner-timewarp-date nil
1303 "*Date to timewarp to for planner.
1304 Should be a string of the form YYYY.MM.DD. If nil, do not timewarp.")
1306 ;; This should be handy for remembering lots of notes onto particular days.
1307 (defun planner-timewarp (date)
1309 (interactive (list (let ((planner-timewarp-date nil)) (planner-read-date))))
1310 (setq planner-timewarp-date date)
1311 (if date (message "Timewarped to %s" date)
1312 (message "Timewarped back to the present")))
1314 (defun planner-today ()
1315 "Return the filename of the current date."
1316 (if planner-use-day-pages
1317 (or planner-timewarp-date (planner-date-to-filename
1318 (decode-time (current-time))))
1319 planner-initial-page))
1321 (defun planner-date-to-filename (date)
1322 "Return the planner filename corresponding to DATE.
1323 DATE is a list (month day year) or an internal date representation."
1324 (if (= (length date) 3)
1325 (format "%04d.%02d.%02d" (elt date 2) (elt date 0) (elt date 1))
1326 (if (= (length date) 2)
1327 (setq date (decode-time date)))
1328 (format "%04d.%02d.%02d"
1330 (elt date 4) ; month
1331 (elt date 3)))) ; day
1333 (defun planner-calculate-date-from-day-offset (origin offset)
1334 "From ORIGIN, calculate the date OFFSET days into the past or future.
1335 ORIGIN can be a buffer name, a list of the form (MONTH DAY YEAR),
1336 or an internal date representation. If OFFSET is positive,
1337 returns a date in the future. If OFFSET is negative, returns the
1338 date -OFFSET days in the past. Return an object that is the
1339 same type as ORIGIN."
1342 (let ((date (planner-filename-to-calendar-date origin)))
1343 (planner-date-to-filename (encode-time 0 0 0 (+ (elt date 1) offset)
1344 (elt date 0) (elt date 2)))))
1345 ((= (length origin) 2)
1346 (encode-time 0 0 0 (+ (elt origin 1) offset)
1347 (elt origin 0) (elt origin 2)))
1348 ((= (length origin) 3)
1350 (decode-time (encode-time 0 0 0 (+ (elt origin 1) offset)
1351 (elt origin 0) (elt origin 2)))))
1352 (list (elt result 4) (elt result 3) (elt result 5))))))
1354 (defun planner-get-previous-existing-day (date)
1355 "Return the planner file immediately before DATE.
1356 DATE is a filename or a list (month day year). When called from
1357 a planner file, DATE defaults to the date of this file, otherwise
1358 it defaults to today. Returns an object of the same type as
1360 (let ((newdate (if (listp date) (planner-date-to-filename date) date))
1362 ;; beginning of hackish part
1363 (mapcar (lambda (elt)
1364 (when (and (or (not result)
1365 (not (or (string= elt result)
1366 (string< elt result))))
1367 (string< elt newdate))
1369 (mapcar 'car (planner-list-daily-files)))
1372 (planner-filename-to-calendar-date result)
1374 (error "No previous planner file"))))
1376 (defun planner-get-next-existing-day (date)
1377 "Return the existing planner file immediately after DATE.
1378 DATE is a filename or a list (month day year). When called from
1379 a planner file, DATE defaults to the date of this file, otherwise
1380 it defaults to today. Returns an object of the same type as
1382 (let ((newdate (if (listp date) (planner-date-to-filename date) date))
1384 ;; beginning of hackish part
1385 (mapcar (lambda (elt)
1386 (when (and (or (not result)
1387 (string< elt result))
1388 (not (or (string= elt newdate)
1389 (string< elt newdate))))
1391 (mapcar 'car (planner-list-daily-files)))
1394 (planner-filename-to-calendar-date result)
1396 (error "No next planner file"))))
1398 (defun planner-yesterday ()
1399 "Return the date of yesterday."
1400 (planner-calculate-date-from-day-offset (planner-today) -1))
1402 (defun planner-tomorrow ()
1403 "Return the date of tomorrow."
1404 (planner-calculate-date-from-day-offset (planner-today) 1))
1406 (defcustom planner-expand-name-favor-future-p nil
1407 "If non-nil, `planner-expand-name' defaults to future dates."
1411 (defcustom planner-expand-name-default "."
1412 "What an empty string means in `planner-expand-name'.
1415 (const :tag "Today" ".")
1416 (const :tag "None" nil)
1420 (defvar planner-expand-name-days-alist '(("sun" . 0)
1427 "Abbreviations for `planner-expand-name'.")
1429 (defun planner-expand-name (name)
1430 "Expand the given NAME to its fullest form.
1431 This typically means that dates like 3.31 will become 2001.03.31.
1432 NOTE: This function no longer uses the current buffer filename for
1434 (let ((now (if planner-use-day-pages
1435 (planner-filename-to-calendar-date (planner-today))
1436 (planner-filename-to-calendar-date
1437 (planner-date-to-filename
1438 (decode-time (current-time))))))
1439 name-year name-month name-day)
1440 (when (string-match "^\\s-*$" name)
1441 (setq name (or planner-expand-name-default "nil")))
1443 ((string= "nil" name) nil)
1444 ((string= "." name) (if (not planner-use-day-pages)
1445 (planner-date-to-filename now)
1447 ((string-match (concat "^\\([1-9][0-9][0-9][0-9]\\.\\)?"
1448 "\\(\\([0-9]+\\)\\.\\)?"
1449 "\\([0-9]+\\)\\(#.*\\)?$") name)
1451 (if (match-string 1 name)
1452 (string-to-number (match-string 1 name)) (nth 2 now)))
1454 (if (match-string 3 name)
1455 (string-to-number (match-string 3 name)) (nth 0 now)))
1457 (if (match-string 4 name)
1458 (string-to-number (match-string 4 name)) (nth 1 now)))
1459 (when (and planner-expand-name-favor-future-p
1460 (planner-time-less-p
1461 (encode-time 59 59 23
1462 name-day name-month name-year)
1465 ((match-string 1 name)) ; Do nothing if the year is specified
1466 ((match-string 2 name)
1467 (setq name-year (1+ name-year)))
1468 ((match-string 4 name)
1469 (setq name-month (1+ name-month)))))
1470 (planner-date-to-filename (encode-time 59 59 23
1471 name-day name-month name-year)))
1472 ((string-match "^\\([-+]\\)\\s-*\\([0-9]+\\)$" name)
1473 ;; Today + or - that number of days
1474 (planner-calculate-date-from-day-offset
1475 (if (not planner-use-day-pages)
1476 (planner-date-to-filename now)
1477 (if (or planner-dates-relative-to-today-flag
1478 (not (planner-page-name))
1479 (not (save-match-data
1480 (string-match planner-date-regexp
1481 (planner-page-name)))))
1483 (planner-page-name)))
1485 (concat (match-string 1 name) (match-string 2 name)))))
1486 ((let ((case-fold-search nil))
1487 (string-match (concat
1488 "^\\([-+]\\)\\s-*\\([0-9]*\\)\\s-*\\("
1489 (mapconcat 'car planner-expand-name-days-alist "\\|")
1490 "\\)\\s-*\\(\\.\\|\\(\\(\\([0-9]+\\.\\)?[0-9]+\\.\\)?"
1493 (let* ((day (cdr (assoc (match-string 3 name)
1494 planner-expand-name-days-alist)))
1495 (offset (string-to-number
1496 (concat (match-string 1 name)
1498 (match-string 2 name)
1499 (not (string= (match-string 2 name) "")))
1500 (match-string 2 name)
1502 (base-date (planner-filename-to-calendar-date
1503 (if (and (match-string 4 name)
1504 (not (string= (match-string 4 name) "")))
1505 (planner-expand-name (match-string 4 name))
1506 (if (not planner-use-day-pages)
1507 (planner-date-to-filename now)
1508 (if (or planner-dates-relative-to-today-flag
1509 (not (planner-page-name))
1510 (not (save-match-data
1513 (planner-page-name)))))
1515 (planner-page-name)))))))
1516 (planner-date-to-filename
1517 (calendar-gregorian-from-absolute
1518 (calendar-dayname-on-or-before
1520 (+ (calendar-absolute-from-gregorian base-date)
1522 (if (< offset 0) 6 0)))))))
1525 (defun planner-get-current-date-filename ()
1526 "Return the date of the daily page currently being viewed.
1527 If no daily page is being viewed, return today's date."
1528 (if (string-match planner-date-regexp (planner-page-name))
1532 (defun planner-filename-to-calendar-date (filename)
1533 "Return the date of the planning file FILENAME.
1534 Date is a list (month day year)."
1535 (unless (string-match planner-date-regexp filename)
1536 (error "Not convertible to a date %s" filename))
1537 (list (string-to-number (match-string 2 filename)) ; month
1538 (string-to-number (match-string 3 filename)) ; day
1539 (string-to-number (match-string 1 filename)))) ; year
1543 (defun planner-narrow-to-section (section &optional create)
1544 "Widen to the whole page and narrow to the section labelled SECTION.
1545 If CREATE is non-nil, create the section if it is not found.
1546 Return non-nil if SECTION was found."
1547 (interactive "MSection: ")
1549 (unless (stringp section)
1550 (setq section (cdr (assoc section planner-sections))))
1551 (goto-char (point-min))
1554 (concat "^*\\s-+" (regexp-quote section) "\\s-*$") nil t)
1556 (funcall planner-create-section-function section)
1557 (goto-char (point-min))
1558 (re-search-forward (concat "^*\\s-+" (regexp-quote section)
1560 (let ((beg (match-beginning 0))
1561 (end (if (re-search-forward "^*\\s-+" nil t)
1562 (match-beginning 0) (point-max))))
1563 (narrow-to-region beg end)
1566 (defun planner-delete-section (section)
1567 "Delete the named SECTION."
1568 (unless (planner-derived-mode-p 'planner-mode)
1569 (error "This is not a planner buffer"))
1570 (unless (stringp section)
1571 (setq section (cdr (assoc section planner-sections))))
1573 (goto-char (point-min))
1574 (when (re-search-forward (concat "^\\*\\s-+" section "\\(\\s-*\\)$") nil t)
1575 (let ((beg (planner-line-beginning-position))
1576 (end (if (re-search-forward "^* " nil t)
1577 (planner-line-beginning-position)
1579 (delete-region beg end))))
1581 (defun planner-delete-section-text (section)
1582 "Delete the text of the named SECTION."
1583 (unless (planner-derived-mode-p 'planner-mode)
1584 (error "This is not a planner buffer"))
1585 (unless (stringp section)
1586 (setq section (cdr (assoc section planner-sections))))
1588 (goto-char (point-min))
1589 (when (re-search-forward (concat "^\\*\\s-+" section "\\(\\s-*\\)$") nil t)
1591 (end (if (re-search-forward "^* " nil t)
1592 (planner-line-beginning-position)
1594 (delete-region beg end)
1595 (goto-char (planner-line-beginning-position)))))
1597 (defun planner-seek-to-first (&optional section)
1598 "Positions the point at the specified SECTION, or Tasks if not specified."
1601 (setq section planner-default-section))
1602 (unless (stringp section)
1603 (setq section (cdr (assoc section planner-sections))))
1605 (goto-char (point-min))
1606 (if (re-search-forward (concat "^\\*\\s-+" section "\\(\\s-*?\\)$") nil t)
1607 (let ((old (point)) new)
1609 (if (re-search-forward "[^\\s-]" nil t)
1611 (goto-char (planner-line-beginning-position))
1612 (unless (looking-at "^\\*\\s-")
1613 (setq new (point)))))
1614 (goto-char (or new old))
1617 (when (or (looking-at "^\\*\\s-+")
1618 (> (forward-line 1) 0)) (insert "\n"))
1619 (when (or (looking-at "^\\*\\s-+")
1620 (> (forward-line 1) 0)) (insert "\n"))
1621 (when (looking-at "^\\*\\s-+") (forward-line -1))))
1622 ;; Section not found, so create it.
1623 (funcall planner-create-section-function section)))
1625 (defun planner-create-at-top (section)
1626 "Create SECTION at top of file."
1627 (goto-char (point-min))
1628 (let ((buffer-status (buffer-modified-p)))
1629 (insert "* " section "\n\n")
1630 (set-buffer-modified-p buffer-status)))
1632 (defun planner-create-at-bottom (section)
1633 "Create SECTION at bottom of file."
1634 (goto-char (point-max))
1635 (let ((buffer-status (buffer-modified-p)))
1636 (insert "\n* " section "\n\n")
1637 (set-buffer-modified-p buffer-status)))
1639 ;;;_ + Basic annotation
1642 (defun planner-annotation-as-kill (arg)
1643 "Copy the current annotation into the kill ring.
1644 When called with a prefix argument, prompt for the link display name."
1646 (let* ((link (run-hook-with-args-until-success
1647 'planner-annotation-functions))
1648 (link-name (if arg (read-string (format "Link name for %s: " link)))))
1649 (unless (= 0 (length link-name))
1650 (setq link (planner-make-link link link-name t)))
1651 (message "Copied '%s' to the kill-ring." link)
1654 (defun planner-annotation-from-planner-note ()
1655 "Return a link to the current page.
1656 Call when the point is on the first line of the note."
1657 (when (and (planner-derived-mode-p 'planner-mode)
1658 (planner-page-name))
1660 (goto-char (planner-line-beginning-position))
1661 (when (looking-at ".\\(#[0-9]+\\)")
1663 (concat (planner-page-name)
1664 (planner-match-string-no-properties 1))
1665 (concat (planner-page-name)
1666 (planner-match-string-no-properties 1))
1669 (defun planner-annotation-from-planner ()
1670 "Return a wiki link to the current wiki page.
1671 Date pages are not linked."
1672 (when (and (planner-derived-mode-p 'planner-mode)
1673 (planner-page-name))
1675 ((string-match planner-date-regexp (planner-page-name))
1676 "") ; None for date pages
1677 (t (planner-make-link (planner-page-name) nil t)))))
1679 (defun planner-annotation-from-wiki ()
1680 "Return the interwiki link to the current wiki page."
1681 (when (and (planner-derived-mode-p 'muse-mode)
1682 muse-current-project
1684 (concat "[[" (car muse-current-project) "#" (muse-page-name) "]]")))
1686 (defun planner-annotation-from-dired ()
1687 "Return the `default-directory' of the current Dired buffer."
1688 (when (eq major-mode 'dired-mode)
1689 (planner-make-link default-directory)))
1691 (defun planner-annotation-from-file-relative ()
1692 "Return the filename of the current buffer relative to `planner-directory'."
1693 (when buffer-file-name
1694 (planner-make-link (file-relative-name buffer-file-name
1695 (planner-directory))
1698 (defcustom planner-annotation-use-relative-file nil
1699 "If t, use relative file links always.
1700 If a function, it is called with the file name. Return value of t
1701 means use relative file links."
1703 :type '(choice (const :tag "Always use relative file links" t)
1704 (const :tag "Never use relative file links" nil)
1707 (defcustom planner-annotation-strip-directory nil
1708 "If non-nil, strip the directory part of the filename from link text."
1712 (defcustom planner-annotation-format-local-file-name nil
1713 "If non-nil, use the result of `planner-annotation-format-local-file-name'."
1715 :type '(choice (const :tag "Use filename as is" nil)
1718 (defun planner-annotation-from-file ()
1719 "Return the filename of the current buffer.
1720 If `planner-annotation-use-relative-file' is t or a function that
1721 returns non-nil, a relative link is used instead. If
1722 `planner-annotation-strip-directory' is non-nil, the directory is
1723 stripped from the link description."
1724 (when buffer-file-name
1726 (if (or (and (functionp planner-annotation-use-relative-file)
1727 (funcall planner-annotation-use-relative-file
1728 (buffer-file-name)))
1729 (equal planner-annotation-use-relative-file t))
1730 (file-relative-name (buffer-file-name) (planner-directory))
1731 (if (functionp planner-annotation-format-local-file-name)
1732 (funcall planner-annotation-format-local-file-name buffer-file-name)
1734 (when planner-annotation-strip-directory
1735 (file-name-nondirectory buffer-file-name))
1739 (defun planner-annotation-from-file-with-position ()
1740 "Return the filename and cursor position of the current buffer.
1741 If `planner-annotation-use-relative-file' is t or a function that
1742 returns non-nil, a relative link is used instead. If
1743 `planner-annotation-strip-directory' is non-nil, the directory is
1744 stripped from the link description."
1745 (when buffer-file-name
1749 (if (or (and (functionp planner-annotation-use-relative-file)
1750 (funcall planner-annotation-use-relative-file
1751 (buffer-file-name)))
1752 (equal planner-annotation-use-relative-file t))
1753 (file-relative-name (buffer-file-name) (planner-directory))
1755 "#" (number-to-string (point)))
1756 (if planner-annotation-strip-directory
1757 (file-name-nondirectory buffer-file-name)
1762 (defun planner-browse-position-url (url)
1763 "If this is a position URL, jump to it."
1764 (when (string-match "^pos://\\(.+\\)#\\([0-9]+\\)$" url)
1765 (let ((file (match-string 1 url))
1766 (pos (string-to-number (match-string 2 url))))
1772 (defun planner-resolve-position-url (id)
1773 "Replace ID with the blog, web or e-mail address of the BBDB record."
1775 (when (string-match "\\`pos://\\(.+\\)#\\([0-9]+\\)" id)
1776 (match-string 1 id))))
1778 (planner-add-protocol "pos://" 'planner-browse-position-url
1779 'planner-resolve-position-url)
1780 (custom-add-option 'planner-annotation-functions
1781 'planner-annotation-from-file-with-position)
1785 (defcustom planner-create-task-hook nil
1786 "Functions to run after a task has been created.
1787 Point will be on the same line as the task."
1789 :group 'planner-tasks)
1791 (defcustom planner-create-task-from-buffer-hook nil
1792 "Functions to run after a task has been created from a buffer.
1793 This will be run before `planner-create-task-hook'.
1794 Point will be on the same line as the task."
1796 :group 'planner-tasks)
1798 (defcustom planner-task-dates-favor-future-p nil
1799 "*If this is non-nil, favor future dates for task creation or movement."
1801 :group 'planner-tasks)
1803 (defcustom planner-default-page "TaskPool"
1804 "Default page for tasks.
1805 This is set to the current planner page, or the last page used
1806 if not on a plan page."
1808 :group 'planner-tasks)
1810 (defcustom planner-tasks-file-behavior 'close
1811 "Controls behavior of task creation and updates.
1812 If 'close, newly-opened files are saved and closed.
1813 If 'save, newly-opened files are saved and left open.
1814 If nil, no actions will be taken."
1815 :group 'planner-tasks
1816 :type '(choice (const :tag "Save and close opened files" 'close)
1817 (const :tag "Save opened files" 'save)
1818 (const :tag "Do nothing" nil)))
1820 (defcustom planner-tasks-never-suppress-fixing-flag t
1821 "Non-nil means always sort, renumber and align tasks whenever
1823 :group 'planner-tasks
1826 (defcustom planner-sort-undated-tasks-equivalent "9999.99.99"
1827 "Date considered for undated tasks.
1828 This option controls task sorting on plan pages. By default,
1829 undated tasks are sorted after dated tasks."
1830 :group 'planner-tasks
1833 (const :tag "Sort undated tasks after dated tasks" "9999.99.99")
1834 (const :tag "Sort undated tasks before dated tasks" "")
1837 (defcustom planner-sort-tasks-key-function 'planner-sort-tasks-default-key
1838 "Function called to determine the sorting key for the current line."
1839 :group 'planner-tasks
1842 (defcustom planner-use-task-numbers nil
1843 "Non-nil means number tasks.
1844 This allows you to refer to past tasks if your tasks are numbered
1845 appropriately. If you set this to nil, you can save space in your
1848 :group 'planner-tasks)
1852 (defun planner-task-info-from-string (page-name string)
1853 "On the planner page PAGE-NAME, parse STRING and return the task as a list.
1854 Argument PAGE-NAME is used to determine whether this is a link
1855 from a plan page or a date page."
1857 (when (string-match "#\\([A-C]\\)\\([0-9]*\\)\\s-+\\(.\\)\\s-+\\(.+\\)"
1859 (let ((priority (planner-match-string-no-properties 1 string))
1860 (number (planner-match-string-no-properties 2 string))
1861 (status (planner-match-string-no-properties 3 string))
1862 (description (planner-match-string-no-properties 4 string))
1863 (case-fold-search nil)
1864 link-text link plan date)
1865 (when (= (length number) 0)
1869 "\\s-+(\\(\\[\\[\\([^])]+\\)\\]\\[\\([^])]+\\)\\]\\]\\))\\s-*$"
1871 (setq link-text (match-string 1 description))
1872 (setq link (match-string 2 description))
1873 (setq description (replace-match "" t t description)))
1875 "\\s-+(\\(\\[\\[\\([^])]+\\)\\]\\]\\))\\s-*$" description)
1876 (setq link-text (match-string 1 description))
1877 (setq link (match-string 2 description))
1878 (setq description (replace-match "" t t description)))
1879 ((string-match "\\s-+(\\([^)]+\\))\\s-*$" description)
1880 (setq link-text (match-string 1 description))
1881 (setq link (match-string 1 description))
1882 (setq description (replace-match "" t t description)))
1883 ((string-match "\\s-+$" description)
1884 (setq description (replace-match "" t t description))))
1886 (setq link (planner-link-base link-text)))
1887 (unless (planner-local-page-p link) (setq link nil))
1888 (if (string-match planner-date-regexp page-name)
1889 ;; We're on a date page, so the link page (if any) should be the
1892 (setq date page-name)
1893 (setq plan (and link
1894 (unless (string-match planner-date-regexp link)
1896 ;; We're on a planner page, so the link page (if any) will be the plan
1897 (setq plan (and page-name (unless (string-match planner-date-regexp
1900 (when (and link (string-match planner-date-regexp link))
1901 (setq date (match-string 0 link))))
1903 priority number status description link link-text plan date)))))
1905 (defun planner-task-info-override (task-info properties)
1906 "Replace fields in TASK-INFO with PROPERTIES.
1907 Acceptable properties are: page-name priority number status
1908 description link link-text plan date."
1909 (let ((fields '(page-name priority number status description
1910 link link-text plan date))
1915 (car (let ((search (memq (car fields) properties)))
1916 (if search (cdr search) task-info)))
1918 (setq fields (cdr fields))
1919 (setq task-info (cdr task-info)))
1922 (defun planner-current-task-info ()
1923 "Parse the current line and return the task information as a list."
1924 (planner-task-info-from-string (planner-page-name)
1926 (planner-line-beginning-position)
1927 (planner-line-end-position))))
1929 (defun planner-task-page (info)
1930 "Return the page of a task given INFO." (nth 0 info))
1931 (defun planner-task-priority (info)
1932 "Return the priority of a task given INFO." (nth 1 info))
1933 (defun planner-task-number (info)
1934 "Return the number of a task given INFO." (nth 2 info))
1935 (defun planner-task-status (info)
1936 "Return the status of a task given INFO." (nth 3 info))
1937 (defun planner-task-description (info)
1938 "Return the description of a task given INFO." (nth 4 info))
1939 (defun planner-task-link (info)
1940 "Return the page linked to by a task given INFO." (nth 5 info))
1941 (defun planner-task-link-text (info)
1942 "Return the link text of a task given INFO." (nth 6 info))
1943 (defun planner-task-plan (info)
1944 "Return the planner page of a task given INFO." (nth 7 info))
1945 (defun planner-task-date (info)
1946 "Return the planner date of a task given INFO." (nth 8 info))
1947 (defun planner-task-link-as-list (info)
1948 "Return a list of all the pages this task is on."
1949 (delq nil (list (nth 7 info) (nth 8 info))))
1953 (defvar planner-create-task-from-info-function
1954 'planner-create-task-from-info-basic
1955 "Function for creating tasks.
1956 Should accept the same arguments as `planner-create-task-from-info-basic'.")
1958 (defun planner-create-task-from-info (info &optional priority number status description link-text date plan)
1959 "Create a task in the date and plan pages based on INFO.
1960 Optional arguments PRIORITY, NUMBER, STATUS, DESCRIPTION,
1961 LINK-TEXT, DATE, and PLAN override those in INFO."
1962 (funcall planner-create-task-from-info-function info priority
1963 number status description link-text date plan))
1965 (defun planner-create-task-from-info-basic
1966 (info &optional priority number status description link-text date plan)
1967 "Create a task in the date and plan pages based on INFO.
1968 Optional arguments PRIORITY, NUMBER, STATUS, DESCRIPTION,
1969 LINK-TEXT, DATE, and PLAN override those in INFO."
1970 (save-window-excursion
1972 ;; page-name priority number status description
1973 ;; link link-text plan date
1974 ;; Create the task in the plan page
1975 (let ((plan-page (or plan (planner-task-plan info)))
1976 (date-page (or date (planner-task-date info)))
1978 (and (equal planner-tasks-file-behavior 'close)
1981 (if (string-match planner-date-regexp
1983 (setq plan-page nil)))
1984 (when (and plan-page (not (string= plan-page "")))
1985 (planner-find-file plan-page)
1986 (planner-seek-task-creation-point)
1987 (insert (planner-format-task info priority number
1989 (planner-make-link date-page)
1990 (planner-make-link date-page))
1992 ;; Create the task in the date page
1993 (when (and date-page (not (string= date-page "")))
1994 (planner-goto date-page)
1995 (planner-seek-task-creation-point)
1996 (insert (planner-format-task info priority number
2000 (planner-task-link-text info))
2003 (run-hooks 'planner-create-task-hook)
2004 (when planner-tasks-file-behavior
2005 (planner-save-buffers live-buffers t))))))
2007 (defvar planner-task-format "#%s%s %s %s%s"
2008 "Format used by `planner-format-task' when inserting new tasks.")
2010 (defun planner-format-task
2011 (task-info &optional priority number status description link-text link)
2012 "Return a string containing TASK-INFO ready to be inserted into a page.
2013 Non-nil values of PRIORITY, NUMBER, STATUS, DESCRIPTION, LINK-TEXT,
2014 and LINK override TASK-INFO."
2015 (format planner-task-format
2016 (or priority (planner-task-priority task-info))
2017 (if planner-use-task-numbers
2018 (format "%-2s" (or number (planner-task-number task-info) ""))
2020 (or status (planner-task-status task-info))
2021 (or description (planner-task-description task-info))
2022 (let ((text (or link-text
2023 (and link (planner-make-link link))
2024 (planner-task-link-text task-info))))
2025 (if (and text (not (equal text "")))
2033 (defun planner-copy-or-move-region (beg end &optional date muffle-errors)
2034 "Move all tasks from BEG to END to DATE.
2035 If this is the original task, it copies it instead of moving.
2036 Most of the time, the original should be kept in a planning file,
2037 but this is not required. `planner-copy-or-move-region' will
2038 copy or move all tasks from the line containing BEG to the line
2039 just before END. If MUFFLE-ERRORS is non-nil, no errors will be
2042 (unless date (setq date
2043 (let ((planner-expand-name-favor-future-p
2044 (or planner-expand-name-favor-future-p
2045 planner-task-dates-favor-future-p)))
2046 (planner-read-date))))
2047 (let ((start (if (< beg end) beg end))
2048 (finish (if (< beg end) end beg))
2049 (buffer (current-buffer))
2052 (live-buffers (when (equal planner-tasks-file-behavior
2055 ;; Invoke planner-copy-or-move-task on each line in reverse
2056 (let ((planner-tasks-file-behavior nil))
2060 (and (goto-char start) (planner-line-beginning-position))
2061 (and (goto-char (1- finish))
2063 (1+ (planner-line-end-position)))))
2064 (when planner-add-task-at-end-flag
2065 (reverse-region (point-min) (point-max)))
2066 (goto-char (point-max))
2068 (goto-char (planner-line-beginning-position))
2069 ;; Non-completed or cancelled tasks only
2071 "^#?\\([A-C]\\)\\([0-9]*\\)\\s-+\\([^XC\n]\\)\\s-+\\(.+\\)")
2073 (when (planner-copy-or-move-task date)
2074 (setq count (1+ count)))
2076 (unless (or muffle-errors (not (interactive-p)))
2079 (elt (planner-current-task-info) 4) err)
2080 (setq error-count (1+ error-count)))
2084 (when planner-add-task-at-end-flag
2085 (reverse-region (point-min) (point-max)))
2086 (when (and (not muffle-errors)
2090 (message (if (> error-count 1) "%d errors." "%d error.")
2092 (when planner-tasks-file-behavior
2093 (planner-save-buffers live-buffers))
2095 count)) ; Return the number of tasks moved.
2099 (defvar planner-jump-to-linked-task-function 'planner-jump-to-linked-task-basic
2100 "Function to jump to a linked task. Function should have one
2101 optional parameter: TASK-INFO.")
2103 (defun planner-jump-to-linked-task (&optional task-info)
2104 "Display the task page linked to by the current task or TASK-INFO."
2105 (funcall planner-jump-to-linked-task-function task-info))
2107 (defun planner-jump-to-linked-task-basic (&optional task-info)
2108 "Display the task page linked to by the current task or TASK-INFO."
2110 (let* ((task-info (or task-info (planner-current-task-info)))
2111 (link (and task-info (planner-task-link task-info))))
2112 (when (planner-local-page-p link)
2113 (planner-find-file (planner-task-link task-info))
2115 (goto-char (point-min))
2116 (when (search-forward (planner-task-description task-info) nil t)
2122 (defvar planner-history-list nil "History list for pages.")
2124 (defvar planner-read-name-function 'planner-read-name-single
2125 "Function to call in order to read the names of pages.")
2127 (defun planner-read-name (file-alist &optional prompt initial)
2128 "Read the name of a valid Wiki page from minibuffer.
2129 FILE-ALIST is a list of (page-name . filename) entries. If PROMPT
2130 is non-nil, it is used as the prompt string. If INITIAL is specified,
2131 it is used as a reasonable default."
2132 (funcall planner-read-name-function file-alist prompt initial))
2134 (defun planner-read-name-single (file-alist &optional prompt initial)
2135 "Read the name of a valid Wiki page from minibuffer with completion.
2136 FILE-ALIST is a list of (page-name . filename) entries. If PROMPT
2137 is non-nil, it is used as the prompt string. If INITIAL is specified,
2138 it is used as a reasonable default."
2139 (let* ((default planner-default-page)
2140 (str (completing-read
2141 (format "%s(default: %s) " (or prompt "Page: ") default)
2142 file-alist nil nil initial 'planner-history-list)))
2144 ((or (null str) (= (length str) 0)) default)
2145 ((string= str "nil") nil)
2148 (defun planner-read-name-no-completion (names &optional prompt initial)
2149 "Read the name of a valid Wiki page from minibuffer without completion.
2150 FILE-ALIST is a list of (page-name . filename) entries. If PROMPT
2151 is non-nil, it is used as the prompt string. If INITIAL is specified,
2152 it is used as a reasonable default."
2153 (let* ((default planner-default-page)
2155 (format "%s(default: %s) " (or prompt "Page: ") default)
2156 initial 'planner-history-list default)))
2158 ((or (null str) (= (length str) 0)) default)
2159 ((string= str "nil") nil)
2162 (defun planner-read-non-date-page (file-alist &optional prompt initial)
2163 "Prompt for a page name that does not match `planner-date-regexp'.
2164 Base completion on FILE-ALIST. If PROMPT is non-nil, use that as
2165 the prompt. If INITIAL is non-nil, use that as the initial contents
2171 (unless (string-match
2172 (concat "^\\(?:" planner-date-regexp "\\)$")
2175 (copy-alist file-alist)))
2178 (defvar planner-find-task-function 'planner-find-task-basic
2179 "Function to find a task based on INFO and POINT.")
2181 (defun planner-find-task (info &optional point)
2182 "Move point to the character before the task described by INFO.
2183 If POINT is specified, start search from that point."
2184 (funcall planner-find-task-function info point))
2186 (defun planner-find-task-basic (info &optional point)
2187 "Move point to the character before the task described by INFO.
2188 If POINT is specified, start search from that point."
2189 (goto-char (or point (point-min)))
2190 (when (re-search-forward
2192 "^#[A-C][0-9]*\\s-+.\\s-+"
2193 (regexp-quote (planner-task-description info))) nil t)
2194 (goto-char (planner-line-beginning-position))))
2196 (defun planner-tasks-equal-p (task-a task-b)
2197 "Return t if TASK-A and TASK-B are equivalent.
2198 This is true if they have the same value for priority, status,
2199 description, plan and date."
2200 (and (string= (or (planner-task-priority task-a) "")
2201 (or (planner-task-priority task-b) ""))
2202 (string= (or (planner-task-status task-a) "")
2203 (or (planner-task-status task-b) ""))
2204 (string= (or (planner-task-description task-a) "")
2205 (or (planner-task-description task-b) ""))
2206 (string= (or (planner-task-plan task-a) "")
2207 (or (planner-task-plan task-b) ""))
2208 (string= (or (planner-task-date task-a) "")
2209 (or (planner-task-date task-b) ""))))
2211 (defun planner-save-buffers (&optional buffer-list suppress-fixing skip-buffer)
2212 "Save all planner buffers.
2213 If BUFFER-LIST is a list of buffers, close all buffers not found
2214 in that list. If SUPPRESS-FIXING is non-nil, do not perform any
2215 planner-related modifications such as task sorting. If
2216 SKIP-BUFFER is non-nil, do not save that buffer."
2218 (setq suppress-fixing (and (not planner-tasks-never-suppress-fixing-flag)
2222 (unless (eq buffer skip-buffer)
2223 (with-current-buffer buffer
2224 ;; Save all planner buffers
2225 (when (and (planner-derived-mode-p 'planner-mode)
2228 (not (string= "" (planner-page-name))))
2229 ;; SUPPRESS-FIXING is negated in the following forms because
2230 ;; it makes more sense to let planner-save-buffers do the
2231 ;; usual actions when the parameter is omitted.
2232 (let ((planner-sort-tasks-automatically
2233 (and planner-sort-tasks-automatically
2234 (not suppress-fixing)))
2235 (planner-renumber-tasks-automatically
2236 (and planner-renumber-tasks-automatically
2237 (not suppress-fixing)))
2238 (planner-align-tasks-automatically
2239 (and planner-align-tasks-automatically
2240 (not suppress-fixing)))
2241 (planner-renumber-notes-automatically
2242 (and planner-renumber-notes-automatically
2243 (not suppress-fixing)))
2244 (planner-tasks-save-behavior nil)
2245 (planner-id-update-automatically nil))
2246 (when (buffer-modified-p)
2248 (when (and buffer-list
2249 (not (memq buffer buffer-list)))
2250 (kill-buffer nil))))))
2255 (defvar planner-task-regexp (concat "^#[A-C][0-9]*\\s-+.\\s-+")
2256 "Regexp used to match tasks.")
2258 (defvar planner-live-task-regexp "^#[ABC][0-9]*\\s-+[_oDP]\\s-+"
2259 "Regular expression matching \"live\" tasks.
2260 A task is live if it is not finished and it is not cancelled.")
2262 (defun planner-extract-tasks (pages &optional condition)
2263 "Parse PAGES and extract all tasks.
2264 If CONDITION is non-nil, it should be a function that
2265 accepts the task info as an argument and returns t if
2266 the task should be added to the list."
2268 (unless (consp (car pages))
2269 (let ((list (planner-file-alist)))
2270 (setq pages (mapcar '(lambda (page)
2271 (cons page (cdr (assoc page list))))
2276 (insert-file-contents (cdar pages))
2277 (goto-char (point-max))
2278 (while (re-search-backward "^#[A-C]" nil t)
2280 (planner-task-info-from-string
2283 (planner-line-beginning-position)
2284 (planner-line-end-position)))))
2287 (funcall condition info)
2289 (setq result (append (list info) result)))))
2290 (setq pages (cdr pages)))
2293 (defun planner-extract-tasks-with-status (pages status)
2294 "Return all tasks on PAGES with the specified STATUS."
2295 (planner-extract-tasks pages
2297 (equal (planner-task-status item)
2300 (defun planner-tasks-tag (beg end attrs)
2301 "Replace the region BEG to END with a report of tasks.
2302 If status is specified in ATTRS, list tasks matching that status only.
2303 To negate the sense of a match, use a regexp."
2304 (delete-region beg end)
2305 (let* ((status (cdr (assoc "status" attrs)))
2306 (tasks (planner-extract-tasks
2307 (planner-get-day-pages nil nil t)
2310 (string-match status (planner-task-status item)))
2314 (planner-make-link (planner-task-page (car tasks)) nil t)
2316 (planner-task-priority (car tasks))
2318 (planner-task-status (car tasks))
2320 (planner-task-description (car tasks))
2322 (setq tasks (cdr tasks)))))
2324 (defvar planner-on-date-page nil
2325 "Internal variable used in `planner-sort-tasks-default-key'.")
2327 (defun planner-sort-tasks-default-key ()
2328 "Provide old sorting behavior.
2329 Day pages sort by status and priority. Plan pages sort by date,
2330 status and priority."
2331 (if planner-on-date-page
2332 (planner-sort-tasks-basic)
2333 (planner-sort-tasks-by-date)))
2335 (defun planner-sort-tasks-basic ()
2336 "Sort tasks by status (_PDXC) and priority (ABC)."
2337 (skip-chars-forward "#ABC")
2338 (let ((case-fold-search t)
2341 (skip-chars-forward "0123456789 ")
2342 (setq status (char-after))
2343 (+ ;(read (current-buffer))
2345 ((eq status ?P) 1000)
2346 ((eq status ?D) 2000)
2347 ((eq status ?X) 3000)
2348 ((eq status ?C) 4000)
2350 (cond ((eq ch ?A) 100)
2355 (defun planner-sort-tasks-by-date ()
2356 "Sort tasks by date, status and priority."
2357 (skip-chars-forward "#ABC")
2358 (let ((ch (char-before))
2360 (skip-chars-forward "0123456789 ")
2361 (setq status (char-after))
2362 (goto-char (planner-line-end-position))
2363 (skip-chars-backward "]) ")
2364 (format "%1c%1c%10s"
2365 (if (or (= status ?X)
2369 (if (= (skip-chars-backward "0123456789.")
2371 (buffer-substring (point)
2373 planner-sort-undated-tasks-equivalent))))
2375 (defun planner-sort-tasks-by-link ()
2376 "Sort tasks by status, priority and link."
2377 (let ((info (planner-current-task-info)))
2378 (concat ;(read (current-buffer))
2380 ((string= (planner-task-status info) "P") "1")
2381 ((string= (planner-task-status info) "D") "2")
2382 ((string= (planner-task-status info) "X") "3")
2383 ((string= (planner-task-status info) "C") "4")
2385 (planner-task-priority info)
2386 (or (planner-task-link info) ""))))
2388 (defun planner-sort-tasks ()
2390 On day pages, sort according to priority and position. On plan
2391 pages, sort according to status, priority, date, and position."
2393 (let ((case-fold-search nil)
2394 (planner-on-date-page (string-match planner-date-regexp
2395 (planner-page-name)))
2396 (old-task (planner-current-task-info))
2397 (line-offset (- (point) (planner-line-beginning-position)))
2398 (old-point (point)))
2399 (goto-char (point-min))
2400 (while (re-search-forward "^#[A-C][0-9]*" nil t)
2401 (goto-char (match-beginning 0))
2402 (let ((here (point)))
2403 (while (and (char-after) (= (char-after) ?#))
2406 (narrow-to-region here (point))
2410 'forward-line 'end-of-line
2411 planner-sort-tasks-key-function nil
2413 (wrong-number-of-arguments ; OLD EMACS, 5 args
2415 'forward-line 'end-of-line
2416 planner-sort-tasks-key-function nil)))
2417 (goto-char (point-max)))))
2420 (planner-find-task old-task)
2421 (forward-char line-offset))
2422 (goto-char old-point))
2423 nil)) ; Must return nil because of write-file-functions
2425 (defun planner-sort-tasks-maybe ()
2426 "Sort tasks depending on `planner-sort-tasks-automatically'."
2427 (when planner-sort-tasks-automatically
2428 (planner-sort-tasks)))
2430 (defun planner-renumber-tasks ()
2431 "Update task numbering to be in sequence once again."
2433 (let ((old-point (point)))
2434 (goto-char (point-min))
2435 (let ((counters (list (cons "A" 1) (cons "B" 1) (cons "C" 1))))
2436 (while (re-search-forward "^#\\([A-C]\\)\\([0-9]+\\)" nil t)
2437 (let ((counter (assoc (match-string 1) counters)))
2438 (replace-match (number-to-string (cdr counter)) t t nil 2)
2439 (setcdr counter (1+ (cdr counter))))))
2440 (goto-char old-point))
2441 nil) ; Must return nil because of write-file-functions
2443 (defun planner-renumber-tasks-maybe ()
2444 "Renumber tasks depending on `planner-renumber-tasks-automatically'."
2445 (when planner-renumber-tasks-automatically
2446 (planner-renumber-tasks)))
2448 (defun planner-fix-tasks ()
2449 "Sort, renumber and align tasks."
2451 (planner-sort-tasks)
2452 (planner-renumber-tasks)
2453 (planner-align-tasks))
2458 (defun planner-create-note (&optional page)
2459 "Create a note to be remembered in PAGE (today if PAGE is nil).
2460 If `planner-reverse-chronological-notes' is non-nil, create the
2461 note at the beginning of the notes section; otherwise, add it to
2462 the end. Position point after the anchor."
2463 (interactive (list (and (planner-derived-mode-p 'planner-mode)
2464 (planner-page-name))))
2465 (planner-goto (or page
2466 (and (planner-derived-mode-p 'planner-mode)
2467 (planner-page-name))
2469 (planner-seek-to-first 'notes)
2471 (when (planner-narrow-to-section 'notes)
2473 (goto-char (point-min))
2474 (while (re-search-forward "^\\.#[0-9]+\\s-+" nil t)
2475 (setq total (1+ total)))
2476 (if planner-reverse-chronological-notes
2477 (progn (goto-char (point-min))
2479 (skip-chars-forward "\n"))
2480 (goto-char (point-max))
2481 (skip-chars-backward "\n")
2482 (when (= (forward-line 1) 1) (insert "\n"))
2483 (when (= (forward-line 1) 1) (insert "\n")))
2484 (insert ".#" (number-to-string (1+ total)) " ")
2485 (unless (eobp) (save-excursion (insert "\n\n")))
2488 (defun planner-delete-note ()
2489 "Delete the current note."
2491 (save-window-excursion
2492 (let ((info (planner-current-note-info)))
2494 (save-window-excursion
2495 (when (planner-jump-to-linked-note info)
2497 (planner-narrow-to-note)
2498 (delete-region (point-min) (point-max)))))
2500 (planner-narrow-to-note)
2501 (delete-region (point-min) (point-max)))))))
2503 (defun planner-format-note (info &optional anchor title timestamp link body)
2504 "Return the string representation of INFO.
2505 ANCHOR, TITLE, TIMESTAMP, LINK and BODY override INFO if present."
2506 (unless anchor (setq anchor (planner-note-anchor info)))
2507 (unless title (setq title (planner-note-title info)))
2508 (unless timestamp (setq timestamp (planner-note-timestamp info)))
2509 (unless link (setq link (planner-note-link info)))
2510 (unless body (setq body (planner-note-body info)))
2511 (concat (if (and anchor (not (string= "" anchor)))
2512 (concat ".#" anchor " ")
2515 (if (and timestamp (not (string= "" timestamp)))
2516 (concat " " timestamp)
2518 (if (and link (not (string= "" link))) (concat " (" link ")") "")
2519 (if (and body (not (string= "" body))) body "")))
2521 (defun planner-update-note ()
2522 "Copy the text from this note to the linked note, if any."
2524 (save-window-excursion
2525 (let ((info (planner-current-note-info))
2528 (when (planner-narrow-to-note)
2529 (setq text (buffer-substring-no-properties (point-min) (point-max)))
2530 ;; Get rid of the anchor.
2531 (when (string-match "^\\.#[0-9]+\\s-+" text)
2532 (setq text (replace-match "" nil t text)))
2533 ;; Get rid of the link
2534 (when (string-match "\\s-+(\\[\\[.+?\\]\\])" text)
2535 (setq text (replace-match "" nil t text)))))
2536 ;; Insert the new body
2537 (when (planner-jump-to-linked-note)
2539 (when (planner-narrow-to-note)
2540 (goto-char (point-min))
2541 (skip-chars-forward ".#0-9")
2542 (delete-region (point) (point-max))
2544 (goto-char (point-min))
2545 (goto-char (planner-line-end-position))
2548 (concat (planner-note-page info) "#"
2549 (planner-note-anchor info)))
2552 ;; Case 1a: Date and plan page exist, new plan page wanted
2553 ;; Case 1b: Date page exists, no plan yet, plan page wanted
2554 ;; Case 2: Date and plan page exist, no plan page wanted
2555 ;; Case 3: No date, just plan page
2556 (defun planner-replan-note (page)
2557 "Change or assign the plan page for the current note.
2558 PAGE-NAME is the new plan page for the note."
2560 (list (planner-read-non-date-page
2561 (planner-file-alist) nil
2562 (planner-note-link-text (planner-current-note-info)))))
2563 (let ((info (planner-current-note-info t)))
2565 (or (string= page (planner-note-plan info))
2566 (string= page (planner-note-date info))))
2567 (error "Same plan page"))
2568 (when (null (or page (planner-note-date info)))
2569 (error "Cannot unplan note without day page"))
2570 (save-window-excursion
2571 ;; Delete the old plan note
2572 (when (planner-note-plan info)
2573 (when (string-match planner-date-regexp (planner-note-page info))
2574 (planner-jump-to-linked-note info))
2576 (planner-narrow-to-note)
2577 (delete-region (point-min) (point-max))))
2580 ;; Create note on plan page
2581 (setq new (planner-create-note page))
2582 (insert (planner-format-note
2584 (if (planner-note-date info)
2586 (concat (planner-note-date info)
2588 (planner-note-anchor info)))
2590 ;; Update note on date page, if any
2592 (when (planner-note-date info)
2593 (if (string-match planner-date-regexp (planner-note-page info))
2595 (planner-find-file (planner-note-date info))
2596 (goto-char (point-min))
2597 (re-search-forward (concat "^\\.#" (planner-note-anchor info)
2600 (planner-jump-to-linked-note info))
2602 (planner-narrow-to-note)
2603 (delete-region (point-min) (point-max))
2604 (insert (planner-format-note
2608 (concat (planner-link-base page) "#"
2609 (number-to-string new)))
2614 ;; - Link back to the task? If we can figure out how to stably link to
2615 ;; a task in the first place...
2617 ;; - Should plan-page-p default to t? be a customizable variable? What
2618 ;; should it be called? I have the urge to write
2619 ;; planner-create-note-from-task-behavior which can have the
2620 ;; following values: 'day, 'plan, 'copy, 'xref ...
2622 (defun planner-create-note-from-task (&optional plan-page-p)
2623 "Create a note based on the current task.
2624 Argument PLAN-PAGE-P is used to determine whether we put the new
2625 note on the task's plan page or on the current page."
2627 (let ((task-info (planner-current-task-info))
2630 ;; If PLAN-PAGE-P and the task has a plan page, create a note on
2631 ;; the plan page. If not, create it on the current page.
2632 (when (and plan-page-p
2633 (string= (planner-task-date task-info)
2634 (planner-task-page task-info)))
2635 (planner-jump-to-linked-task task-info))
2636 (setq note-num (planner-create-note (planner-page-name)))
2638 (save-window-excursion
2639 (when (planner-find-task task-info)
2640 (planner-edit-task-description
2641 (concat (planner-task-description task-info) " "
2643 (concat (planner-page-name) "#"
2644 (number-to-string note-num))
2645 (format "(%d)" note-num)))))))
2646 (insert " " (planner-task-description task-info) "\n\n"))))
2648 (defun planner-create-note-from-context (&optional plan-page-p)
2649 "Create a note based on the current context.
2650 If on a task item, call `planner-create-note-from-task'.
2651 Anywhere else, call `Footnote-add-footnote' if footnote has been
2652 loaded, else, call `planner-create-note'."
2655 (defun planner-narrow-to-note (&optional page note-number)
2656 "Narrow to the specified note. Widen and return nil if note is not found.
2657 If PAGE is nil, use current page.
2658 If NOTE-NUMBER is nil, use current note.
2659 Undefined behavior if PAGE is (non-nil and not today) and NOTE-NUMBER is nil."
2660 (when page (planner-goto page))
2665 (goto-char (point-min))
2666 (when (re-search-forward (concat "^\\.#" note-number) nil t)
2667 (setq beginning (match-beginning 0))))
2668 (goto-char (planner-line-end-position))
2669 (when (re-search-backward "^\\.#[0-9]+" nil t)
2670 (setq beginning (planner-line-beginning-position))))
2672 ;; Search for the end
2677 (and (re-search-forward "^\\(\\.#\\|* \\)" nil t)
2678 (match-beginning 0)))
2682 (defun planner-note-page (note-info)
2683 "Return the page specified by NOTE-INFO."
2685 (defun planner-note-anchor (note-info)
2686 "Return the anchor specified by NOTE-INFO."
2688 (defun planner-note-title (note-info)
2689 "Return the title specified by NOTE-INFO."
2691 (defun planner-note-timestamp (note-info)
2692 "Return the timestamp specified by NOTE-INFO."
2694 (defun planner-note-link (note-info)
2695 "Return the link specified by NOTE-INFO."
2697 (defun planner-note-link-text (note-info)
2698 "Return the link text specified by NOTE-INFO."
2700 (defun planner-note-body (note-info)
2701 "Return the timestamp specified by NOTE-INFO."
2704 (defun planner-note-date (note-info)
2705 "Return the date for NOTE-INFO."
2707 ((string-match planner-date-regexp (planner-note-page note-info))
2708 (planner-note-page note-info))
2709 ((and (planner-note-link note-info)
2710 (string-match planner-date-regexp (planner-note-link note-info)))
2711 (planner-link-base (planner-note-link note-info)))))
2713 (defun planner-note-plan (note-info)
2714 "Return the date for NOTE-INFO."
2716 ((null (string-match planner-date-regexp (planner-note-page note-info)))
2717 (planner-note-page note-info))
2718 ((and (planner-note-link note-info)
2719 (null (string-match planner-date-regexp
2720 (planner-note-link note-info))))
2721 (planner-link-base (planner-note-link note-info)))))
2723 (defun planner-current-note-info (&optional include-body)
2724 "Parse the current note and return the note information as a list.
2725 The list is of the form (PAGE ANCHOR TITLE TIMESTAMP LINK BODY).
2726 If INCLUDE-BODY is non-nil, the list will include the body of the
2730 (when (planner-narrow-to-note)
2731 (goto-char (point-min))
2732 (when (looking-at "^\\.#\\([0-9]+\\)\\s-+\\(.+\\)")
2733 (let ((anchor (planner-match-string-no-properties 1))
2734 (title (planner-match-string-no-properties 2))
2739 (if (featurep 'planner-multi)
2740 (concat "\\(" muse-explicit-link-regexp "\\)"
2742 (regexp-quote planner-multi-separator)
2743 muse-explicit-link-regexp
2745 muse-explicit-link-regexp)
2748 (setq link (planner-match-string-no-properties 1 title))
2749 (setq title (replace-match "" nil t title)))
2750 (when (string-match "\\s-*\\([0-9]+:[0-9][0-9]\\)" title)
2751 (setq timestamp (planner-match-string-no-properties 1 title))
2752 (setq title (replace-match "" nil t title)))
2753 (list (planner-page-name) anchor title timestamp link
2754 (and include-body (buffer-substring-no-properties
2755 (planner-line-end-position)
2756 (point-max))))))))))
2758 (defun planner-search-notes-internal (regexp &optional limit include-body)
2759 "Return an alist of all notes in daily plan pages containing REGEXP.
2760 The alist is of the form ((REFERENCE TITLE BODY) (REFERENCE TITLE BODY)
2761 ...). If LIMIT is non-nil, do not search days before LIMIT. If
2762 INCLUDE-BODY is non-nil, return the body text, else return nil."
2763 (let ((pages (planner-get-day-pages limit t))
2765 page start anchor text results title page-results)
2767 (setq page (caar pages)
2768 filename (cdar pages))
2770 (when (file-readable-p filename)
2771 (insert-file-contents filename)
2773 (setq page-results nil)
2774 ;; Find the first note
2775 (when (re-search-forward "\\.\\(#[0-9]+\\)\\s-+\\(.*\\)" nil t)
2776 (setq start (match-beginning 2))
2777 (setq anchor (match-string 1))
2778 (setq title (match-string 2)))
2779 (while (re-search-forward "\\.\\(#[0-9]+\\)\\s-+\\(.*\\)" nil t)
2780 ;; The text between start and (1- (match-beginning 0))
2781 ;; is the note body.
2782 (when (save-excursion
2783 (save-match-data (re-search-backward regexp start t)))
2784 (add-to-list 'page-results
2785 (list (concat page anchor)
2788 (buffer-substring-no-properties
2791 (setq start (match-beginning 2))
2792 (setq anchor (match-string 1))
2793 (setq title (match-string 2)))
2795 (goto-char (point-max))
2796 (when (save-excursion (re-search-backward regexp start t))
2797 (add-to-list 'page-results
2798 (list (concat page anchor)
2801 (buffer-substring-no-properties
2804 (when planner-reverse-chronological-notes
2805 (setq page-results (nreverse page-results))))
2806 (setq results (append page-results results)))
2807 (setq pages (cdr pages)))
2810 (defun planner-jump-to-linked-note (&optional note-info)
2811 "Display the note linked to by the current note or NOTE-INFO if non-nil."
2813 (setq note-info (or note-info (planner-current-note-info)))
2814 (when (and (planner-note-link note-info)
2815 (save-window-excursion
2816 (planner-visit-link (planner-note-link note-info))))
2817 (planner-visit-link (planner-note-link note-info))
2821 (defun planner-renumber-notes ()
2822 "Update note numbering."
2824 (let ((old-point (point))
2827 (if planner-reverse-chronological-notes (point-max) (point-min)))
2828 (while (if planner-reverse-chronological-notes
2829 (re-search-backward "^\\.#\\([0-9]+\\)" nil t)
2830 (re-search-forward "^\\.#\\([0-9]+\\)" nil t))
2831 (replace-match (number-to-string counter) t t nil 1)
2832 (when planner-reverse-chronological-notes
2833 (goto-char (planner-line-beginning-position)))
2834 (setq counter (1+ counter)))
2835 (goto-char old-point))
2836 nil) ; Must return nil because of write-file-functions
2838 (defun planner-renumber-notes-maybe ()
2839 "Renumber notes depending on `planner-renumber-notes-automatically'."
2840 (when planner-renumber-notes-automatically
2841 (planner-renumber-notes)))
2845 (defgroup planner-fontlock nil
2846 "Font-locking for planner.el pages."
2850 (defface planner-completed-task-face
2851 (if (featurep 'xemacs)
2852 '((t (:strikethru t :foreground "gray")))
2853 '((t (:strike-through t :foreground "gray"))))
2854 "Face for completed tasks."
2855 :group 'planner-fontlock)
2857 (defface planner-cancelled-task-face
2858 (if (featurep 'xemacs)
2859 '((t (:strikethru t :foreground "gray")))
2860 '((t (:strike-through t :foreground "gray"))))
2861 "Face for cancelled tasks."
2862 :group 'planner-fontlock)
2864 (defface planner-delegated-task-face
2865 '((t (:underline t)))
2866 "Face for delegated tasks."
2867 :group 'planner-fontlock)
2869 (defface planner-in-progress-task-face
2870 (if (featurep 'xemacs)
2872 '((t (:slant oblique))))
2873 "Face for tasks in progress."
2874 :group 'planner-fontlock)
2875 (defface planner-high-priority-task-face '((t (:foreground "red")))
2876 "Face for high-priority tasks."
2877 :group 'planner-fontlock)
2878 (defface planner-medium-priority-task-face '((t (:foreground "green")))
2879 "Face for medium-priority tasks."
2880 :group 'planner-fontlock)
2881 (defface planner-low-priority-task-face '((t (:foreground "blue")))
2882 "Face for low-priority tasks."
2883 :group 'planner-fontlock)
2885 (defface planner-note-headline-face
2886 '((((class color) (background light))
2887 (:foreground "dark slate blue" :bold t))
2888 (((class color) (background dark))
2889 (:foreground "pale turquoise" :bold t))
2891 "Face for note headlines."
2892 :group 'planner-fontlock)
2894 ;; Thanks to Oliver (oik AT gmx DOT net)
2895 (defun planner-align-tasks ()
2896 "Align tasks neatly.
2897 You can add this to `write-file-functions'to have the tasks
2898 automatically lined up whenever you save. For best results,
2899 ensure `planner-align-tasks' is run after
2900 `planner-renumber-tasks'."
2903 (goto-char (point-min))
2904 (while (re-search-forward "^#\\([A-C]\\)\\([0-9]*\\)\\(\\s-+\\)" nil t)
2907 ;; (make-string (max (- (length (match-string 2))) 0) ?\s)
2908 ;; is better, but relies on a CVSism.
2909 (let ((length (length (match-string 2))))
2911 ((and (= length 0) planner-use-task-numbers) " ")
2915 nil) ; Return nil so that we can add this to write-file-functions
2917 (defun planner-align-tasks-maybe ()
2918 "Align tasks depending on `planner-align-tasks-automatically'."
2919 (when planner-align-tasks-automatically
2920 (planner-align-tasks)))
2922 (defun planner-align-table ()
2923 "Align table neatly. Take account of links which hides characters when
2925 Perhaps, guts of this should really be inside muse..."
2928 (when (fboundp 'align-regexp)
2929 (align-regexp (point-min) (point-max) "\\(\\s-*\\)|" 1 1 t))
2930 (goto-char (point-min))
2931 (while (re-search-forward (concat "^" muse-explicit-link-regexp) nil t)
2932 (let ((link (match-string 1))
2933 (desc (match-string 2)))
2935 (make-string (if desc
2937 0) (aref " " 0)))))))
2939 ;; FIXME: Is there a better way to do this?
2941 (defun planner-highlight-region (beg end identifier priority properties)
2942 "Add the specified text properties to the overlay or region.
2943 BEG and END are the start and end of the region. IDENTIFIER is a
2944 symbol that identifies this particular overlay. PRIORITY controls
2945 how important this overlay is. PROPERTIES is a list of properties
2946 or attributes to apply."
2947 (if (featurep 'xemacs)
2948 (let ((extent (make-extent beg end)))
2949 (set-extent-properties extent properties)
2950 (set-extent-property extent 'priority priority))
2951 (if (functionp 'overlay-put)
2953 (let ((overlay (make-overlay beg end)))
2954 (overlay-put overlay identifier t)
2955 (overlay-put overlay 'planner t)
2956 (overlay-put overlay 'priority priority)
2958 (overlay-put overlay (car properties) (cadr properties))
2959 (setq properties (cddr properties)))))
2960 (add-text-properties beg end properties))))
2962 (defcustom planner-hide-task-status-when-highlighting nil
2963 "*If non-nil, hide task status when font-locking."
2965 :group 'planner-fontlock)
2967 (defun planner-highlight-tasks (beg end &optional verbose)
2968 "Highlight tasks from BEG to END. VERBOSE is ignored."
2970 (while (re-search-forward (concat "^#\\([A-C]\\)\\([0-9]*\\)\\s-+\\("
2971 planner-marks-regexp
2973 (let ((mark (match-string 3))
2974 (priority (match-string 1))
2979 ((string= priority "A") '(planner-high-priority-task-face))
2980 ((string= priority "B") '(planner-medium-priority-task-face))
2981 ((string= priority "C") '(planner-low-priority-task-face)))
2983 ((string= mark "X") '(planner-completed-task-face))
2984 ((string= mark "D") '(planner-delegated-task-face))
2985 ((string= mark "C") '(planner-cancelled-task-face))
2986 ((string= mark "o") '(planner-in-progress-task-face)))))
2987 (if (featurep 'xemacs)
2988 (mapcar (lambda (face)
2990 (planner-highlight-region
2991 (match-beginning 0) (match-end 3) 'planner-task 50
2992 (list 'face face)))) faces)
2993 (planner-highlight-region
2994 (match-beginning 0) (match-end 3) 'planner-task 50
2995 (list 'face (mapcar 'face-attr-construct faces))))
2996 (planner-highlight-region
2997 (match-end 3) (planner-line-end-position)
3002 ((string= mark "X") 'planner-completed-task-face)
3003 ((string= mark "D") 'planner-delegated-task-face)
3004 ((string= mark "C") 'planner-cancelled-task-face)
3005 ((string= mark "o") 'planner-in-progress-task-face))))
3006 (when planner-hide-task-status-when-highlighting
3007 (planner-highlight-region
3008 (match-beginning 3) (1+ (match-end 3))
3011 (list 'invisible t))))))
3013 (defun planner-highlight-notes (beg end &optional verbose)
3014 "Highlight notes as second-level headers from BEG to END.
3015 VERBOSE is ignored."
3017 (while (re-search-forward "^\\.#\\([0-9]+\\) [^(\n]+" end t)
3018 (add-text-properties
3019 (match-beginning 0) (match-end 0)
3020 '(face planner-note-headline-face))))
3022 (defun planner-notes-get-headlines (&optional limit)
3023 "Return note headlines on the current page.
3024 If LIMIT is non-nil, return only that many from the top."
3025 (when (stringp limit) (setq limit (string-to-number limit)))
3030 (goto-char (point-min))
3032 (re-search-forward "^.\\(#[0-9]+\\)\\s-+\\(.+\\)" nil t)
3039 (planner-match-string-no-properties 1)
3040 (planner-match-string-no-properties 2))
3042 (if limit (setq limit (1- limit))))))
3047 ;; I want to compress the list of day pages. Arranging them by month
3048 ;; may be a good strategy, although a calendar would be optimal.
3050 (defun planner-index ()
3051 "Display an index of all known Wiki pages."
3053 (let ((muse-current-project (muse-project planner-project)))
3054 (message "Generating Muse index...")
3055 (pop-to-buffer (planner-generate-index))
3056 (goto-char (point-min))
3058 (message "Generating Muse index...done")))
3060 (defun planner-generate-index (&optional as-list exclude-private)
3061 "Generate an index of all Wiki pages.
3062 List planner pages separately. If AS-LIST is non-nil, format it
3063 as a list. If EXCLUDE-PRIVATE is non-nil, exclude anything for
3064 which `muse-project-private-p' returns non-nil."
3065 (let ((index (planner-index-as-string as-list exclude-private)))
3066 (with-current-buffer (get-buffer-create "*Planner Index*")
3071 (defun planner-index-as-string (&optional as-list exclude-private
3073 "Generate an index of all Wiki pages.
3074 Day pages are listed separately.
3076 If AS-LIST is non-nil, format it as a list.
3078 If EXCLUDE-PRIVATE is non-nil, exclude anything for which
3079 `muse-project-private-p' returns non-nil.
3081 If EXCLUDE-DAYPAGES is non-nil, exclude day pages from the list."
3082 (let ((index (muse-index-as-string as-list exclude-private)))
3085 (goto-char (point-min))
3086 (delete-matching-lines
3087 "\\[\\[[0-9][0-9][0-9][0-9]\\.[0-9][0-9]\\.[0-9][0-9]\\]\\]")
3088 (unless exclude-daypages
3089 (goto-char (point-max))
3090 (unless (bolp) (insert "\n"))
3091 (if planner-publish-dates-first-p
3093 (goto-char (point-min))
3095 (goto-char (point-min)))
3097 (let ((dates (mapcar 'car (planner-list-daily-files)))
3100 (setq month (substring (car dates) 0 7))
3101 (unless (string= month last-month)
3102 (setq last-month month)
3103 (insert "\n" month " |"))
3104 (insert " [[" (car dates) "][."
3105 (substring (car dates) 8)
3107 (setq dates (cdr dates)))
3108 (when planner-publish-dates-first-p
3114 (defun planner-annotation-from-info ()
3115 "If called from an info node, return an annotation.
3116 Suitable for use in `planner-annotation-functions'."
3117 (when (eq major-mode 'Info-mode)
3119 (concat "info://" Info-current-file "#" Info-current-node)
3120 (if (and (not (equal Info-current-file "dir"))
3121 (equal Info-current-node "Top"))
3122 (file-name-nondirectory Info-current-file)
3126 (add-hook 'planner-annotation-functions 'planner-annotation-from-info)
3127 (custom-add-option 'planner-annotation-functions 'planner-annotation-from-info)
3129 ;;;_ + Common mail functions
3131 (defun planner-get-name-from-address (address)
3132 "Return the name for ADDRESS to be used in links."
3133 (let ((addr (mail-extract-address-components address)))
3134 (or (car addr) (cadr addr))))
3136 ;;;_* User functions
3140 (defun planner-page-file (page &optional no-check-p)
3141 "Return a filename if PAGE exists within `planner-project'.
3142 If NO-CHECK-P is non-nil, the planner project files are always updated."
3143 (muse-project-page-file page planner-project))
3146 (defun plan (&optional force-days)
3147 "Start your planning for the day, carrying unfinished tasks forward.
3149 If FORCE-DAYS is a positive integer, search that many days in the past
3150 for unfinished tasks.
3151 If FORCE-DAYS is 0 or t, scan all days.
3152 If FORCE-DAYS is nil, use the value of `planner-carry-tasks-forward'
3153 instead, except t means scan only yesterday."
3154 ;; Special treatment of t for planner-carry-tasks-forward is for
3155 ;; backward compatibility.
3157 (unless muse-project-alist
3158 (planner-display-warning
3159 (concat "The variable `muse-project-alist' has not defined.\n"
3160 "\nSee the \"Creating Your Planner\" chapter in the Planner"
3161 " manual\nfor details on how to set this up."))
3162 (error "The variable `muse-project-alist' has not been defined"))
3163 (if planner-use-day-pages
3167 (if (equal planner-carry-tasks-forward t)
3169 planner-carry-tasks-forward)))
3170 (when (and (integerp force-days)
3172 (setq force-days t))
3173 (planner-goto-today)
3174 (let* ((today (planner-today))
3175 (names (planner-get-day-pages nil (planner-yesterday)))
3176 (today-buffer (current-buffer))
3177 (planner-tasks-file-behavior
3178 ;; Force saving so that the file list can be updated
3179 (or planner-tasks-file-behavior
3181 (planner-use-other-window nil)
3183 (equal planner-tasks-file-behavior
3186 ;; Limit the list for force-days
3187 (when (and (integerp force-days)
3188 (> (length names) force-days))
3189 (setcdr (nthcdr (1- force-days) names) nil))
3192 (find-file (cdar names))
3193 ;; Attempt to copy all the tasks
3194 (when (not (equal today (planner-page-name)))
3195 (let ((planner-tasks-file-behavior nil))
3196 (planner-copy-or-move-region (point-min) (point-max)
3198 (unless (buffer-modified-p)
3199 (kill-buffer (current-buffer))))
3200 (setq names (cdr names))))
3201 ;; Jump to the most recent daily page
3202 (if (or planner-carry-tasks-forward
3203 (planner-page-file today)
3205 (planner-goto-today)
3206 (planner-goto (caar names)))
3207 ;; Save/kill files if configured to do so
3208 (when planner-tasks-file-behavior
3209 (planner-save-buffers live-buffers))))
3210 (planner-find-file (or planner-default-page
3211 planner-initial-page))))
3213 (defvar planner-goto-hook '(planner-seek-to-first)
3214 "Functions called after a planner page is opened.")
3217 (defun planner-goto (date &optional just-show)
3218 "Jump to the planning page for DATE.
3219 If no page for DATE exists and JUST-SHOW is non-nil, don't create
3220 a new page - simply return nil."
3221 (interactive (list (or
3223 (planner-read-non-date-page (planner-file-alist)))))
3224 (if (or (not just-show) (planner-page-exists-p date))
3226 (planner-find-file date
3227 (if planner-use-other-window
3228 'find-file-other-window
3231 (goto-char (point-min))
3232 (run-hooks 'planner-goto-hook)
3233 ;; planner-goto-hook returns nil
3235 ;; File not found, and not supposed to be created.
3236 (when (interactive-p)
3237 (message "No planner file for %s." date))
3242 (defun planner-goto-plan-page (page)
3243 "Opens PAGE in the the `planner-project' wiki.
3244 Use `planner-goto' if you want fancy calendar completion."
3245 (interactive (list (planner-read-name (planner-file-alist))))
3246 (planner-find-file page))
3249 (defun planner-show (date)
3250 "Show the plan page for DATE in another window, but don't select it.
3251 If no page for DATE exists, return nil."
3252 (interactive (list (planner-read-date)))
3253 (save-selected-window
3254 (let ((planner-use-other-window t))
3255 (planner-goto date planner-show-only-existing))))
3258 (defun planner-goto-today ()
3259 "Jump to the planning page for today."
3261 (planner-goto (planner-today)))
3264 (defun planner-goto-most-recent ()
3265 "Go to the most recent day with planning info."
3268 (planner-get-previous-existing-day
3269 (planner-calculate-date-from-day-offset
3270 (planner-get-current-date-filename) 1))))
3273 (defun planner-goto-yesterday (&optional days)
3274 "Goto the planner page DAYS before the currently displayed date.
3275 If DAYS is nil, goes to the day immediately before the currently
3276 displayed date. If the current buffer is not a daily planner
3277 page, calculates date based on today."
3279 (let ((planner-use-other-window nil))
3280 (planner-goto (planner-calculate-date-from-day-offset
3281 (planner-get-current-date-filename) (or (- days) -1)))))
3284 (defun planner-goto-tomorrow (&optional days)
3285 "Goto the planner page DAYS after the currently displayed date.
3286 If DAYS is nil, goes to the day immediately after the currently
3287 displayed date. If the current buffer is not a daily planner
3288 page, calculates date based on today."
3290 (let ((planner-use-other-window nil))
3291 (planner-goto (planner-calculate-date-from-day-offset
3292 (planner-get-current-date-filename) (or days 1)))))
3295 (defun planner-goto-previous-daily-page ()
3296 "Goto the last plan page before the current date.
3297 The current date is taken from the day page in the current
3298 buffer, or today if the current buffer is not a planner page.
3299 Does not create pages if they do not yet exist."
3301 (let ((planner-use-other-window nil))
3302 (planner-goto (planner-get-previous-existing-day
3303 (planner-get-current-date-filename)))))
3306 (defun planner-goto-next-daily-page ()
3307 "Goto the first plan page after the current date.
3308 The current date is taken from the day page in the current
3309 buffer, or today if the current buffer is not a planner page.
3310 Does not create pages if they do not yet exist."
3312 (let ((planner-use-other-window nil))
3313 (planner-goto (planner-get-next-existing-day
3314 (planner-get-current-date-filename)))))
3321 (defun planner-create-high-priority-task-from-buffer ()
3322 "Create a high-priority task based on this buffer.
3323 Do not use this in LISP programs. Instead, set the value of
3324 `planner-default-task-priority' and call `planner-create-task' or
3325 `planner-create-task-from-buffer'."
3327 (let ((planner-default-task-priority "A"))
3328 (call-interactively 'planner-create-task-from-buffer)))
3331 (defun planner-create-medium-priority-task-from-buffer ()
3332 "Create a high-priority task based on this buffer.
3333 Do not use this in LISP programs. Instead, set the value of
3334 `planner-default-task-priority' and call `planner-create-task' or
3335 `planner-create-task-from-buffer'."
3337 (let ((planner-default-task-priority "B"))
3338 (call-interactively 'planner-create-task-from-buffer)))
3341 (defun planner-create-low-priority-task-from-buffer ()
3342 "Create a high-priority task based on this buffer.
3343 Do not use this in LISP programs. Instead, set the value of
3344 `planner-default-task-priority' and call `planner-create-task' or
3345 `planner-create-task-from-buffer'."
3347 (let ((planner-default-task-priority "C"))
3348 (call-interactively 'planner-create-task-from-buffer)))
3350 (defun planner-read-task ()
3351 "Return a list of information for a task."
3353 (read-string "Describe task: ")
3354 (when planner-use-day-pages
3356 ;; Universal prefix means pick up from current page
3357 ((and current-prefix-arg
3358 (planner-derived-mode-p 'planner-mode)
3359 (string-match planner-date-regexp (planner-page-name)))
3360 (planner-page-name))
3361 ;; Date selected in calendar
3362 ((condition-case nil (calendar-cursor-to-date) (error nil))
3363 (planner-date-to-filename (calendar-cursor-to-date)))
3365 (t (let ((planner-expand-name-favor-future-p
3366 (or planner-expand-name-favor-future-p
3367 planner-task-dates-favor-future-p)))
3368 (planner-read-date)))))
3369 (when planner-use-plan-pages
3370 (if (and current-prefix-arg (planner-derived-mode-p 'planner-mode)
3371 (not (string-match planner-date-regexp (planner-page-name))))
3372 ;; Universal prefix means pick up from current page
3374 (let ((planner-default-page
3375 (if (and (planner-derived-mode-p 'planner-mode)
3377 (not (string-match planner-date-regexp
3378 (planner-page-name))))
3380 planner-default-page)))
3381 (planner-read-non-date-page
3382 (planner-file-alist)))))
3383 planner-default-task-status))
3385 ;; NOTE: Prefix arg changed to prompt for PLAN-PAGE instead of
3388 (defun planner-create-task-from-buffer (title date &optional plan-page status)
3389 "Create a new task named TITLE on DATE based on the current buffer.
3390 With a prefix, do not prompt for PLAN-PAGE. The task is
3391 associated with PLAN-PAGE if non-nil. If STATUS is non-nil, use
3392 that as the status for the task. Otherwise, use
3393 `planner-default-task-status'. See `planner-create-task' for more
3395 (interactive (planner-read-task))
3396 (setq planner-default-page plan-page)
3397 (let ((planner-create-task-hook (append planner-create-task-from-buffer-hook
3398 planner-create-task-hook))
3399 (annotation (run-hook-with-args-until-success
3400 'planner-annotation-functions)))
3401 (when (and planner-annotation-symbol-string
3402 (string-match planner-annotation-symbol-string title))
3403 (setq title (replace-match (or annotation "") t t title)
3405 (planner-create-task title
3407 (string-match planner-date-regexp date))
3413 (defun planner-create-task (title date &optional annotation plan-page status)
3414 "Create a new task named TITLE based on the current Wiki page.
3415 If DATE is non-nil, makes a daily entry on DATE, else makes an
3416 entry in today's planner page. It's assumed that the current Wiki
3417 page is the page you're using to plan an activity. Any time
3418 accrued to this task will be applied to that page's name in the
3419 timelog file, assuming you use timeclock. If ANNOTATION is
3420 non-nil, it will be used for the page annotation. If PLAN-PAGE is
3421 non-nil, the task is associated with the given page. If STATUS is
3422 non-nil, use that as the status for the task. Otherwise, use
3423 `planner-default-task-status'.
3425 If called with an interactive prefix argument, do not prompt for
3428 You probably want to call `planner-create-task-from-buffer' instead."
3431 (read-string "Describe task: ")
3432 (when planner-use-day-pages
3434 ;; Universal prefix means pick up from current page
3435 ((and current-prefix-arg
3436 (planner-derived-mode-p 'planner-mode)
3437 (string-match planner-date-regexp (planner-page-name)))
3438 (planner-page-name))
3439 ;; Date selected in calendar
3440 ((condition-case nil (calendar-cursor-to-date) (error nil))
3441 (planner-date-to-filename (calendar-cursor-to-date)))
3443 (t (let ((planner-expand-name-favor-future-p
3444 (or planner-expand-name-favor-future-p
3445 planner-task-dates-favor-future-p)))
3446 (planner-read-date)))))
3447 nil ;; No annotation, interactively
3448 (when planner-use-plan-pages
3449 (if (and current-prefix-arg (planner-derived-mode-p 'planner-mode)
3450 (not (string-match planner-date-regexp (planner-page-name))))
3451 ;; Universal prefix means pick up from current page
3453 (let ((planner-default-page
3454 (if (and (planner-derived-mode-p 'planner-mode)
3456 (not (string-match planner-date-regexp
3457 (planner-page-name))))
3459 planner-default-page)))
3460 (planner-read-non-date-page
3461 (planner-file-alist)))))
3462 planner-default-task-status))
3463 (setq planner-default-page plan-page)
3464 (planner-create-task-from-info
3466 planner-default-task-priority ; priority
3468 (or status planner-default-task-status) ; status
3470 (not (string= annotation ""))
3473 (not (string= plan-page annotation))
3474 (not (string= (concat "[[" plan-page "]]") annotation)))))
3475 ;; Used C-u to make a plan-page annotation, so preserve
3477 (concat title " : " annotation)
3478 title) ; description
3479 ;; link: If creating this from a planner plan page, use the
3480 ;; current page name
3481 (and plan-page (planner-make-link plan-page)) ; link text
3485 (defun planner-create-task-from-note (title date &optional plan-page status)
3486 "Create a task based on the current note with TITLE, DATE, PLAN-PAGE and
3489 A more do-what-I-mean way to do this is to position point on the first
3490 line of a note (.#1 ...) and call `planner-create-task-from-buffer'."
3491 (interactive (let* ((info (planner-current-note-info))
3492 (planner-default-page (and info
3493 (planner-note-plan info))))
3496 (error "Not in a planner note"))))
3497 (let* ((info (planner-current-note-info))
3498 (annotation (planner-make-link (concat (planner-note-page info)
3500 (planner-note-anchor info)))))
3501 (when (and planner-annotation-symbol-string
3502 (string-match planner-annotation-symbol-string title))
3503 (setq title (replace-match (or annotation "") t t title)
3505 (planner-create-task title
3506 (when (and date (string-match planner-date-regexp
3516 (defvar planner-copy-or-move-task-suppress-duplicates t
3517 "*If non-nil, do not create duplicate tasks.")
3519 (defun planner-replan-task-basic (page-name)
3520 "Change or assign the plan page for the current task.
3521 PAGE-NAME is the new plan page for the task. Use
3522 `planner-copy-or-move-task' if you want to change the date.
3523 With a prefix, provide the current link text for editing."
3526 (planner-file-alist) nil
3527 (when current-prefix-arg
3528 (planner-task-plan (planner-current-task-info))))))
3529 (let ((info (planner-current-task-info)))
3530 (when (and info (not (equal page-name (planner-task-plan info))))
3531 (with-planner-update-setup
3532 ;; Delete from old plan page
3533 (when (planner-task-plan info)
3534 (planner-find-file (planner-task-plan info))
3535 (when (planner-find-task info)
3536 (delete-region (planner-line-beginning-position)
3537 (1+ (planner-line-end-position)))))
3538 ;; Add to new plan page, if any, and update date
3541 (planner-find-file page-name)
3542 (planner-seek-task-creation-point)
3543 (insert (planner-format-task info nil nil nil nil
3544 (or (planner-task-date info)
3546 (or (planner-task-date info)
3550 (planner-update-task))
3551 ;; Else, go to day page and update line
3552 (planner-find-file (planner-task-date info))
3553 (if (planner-find-task info)
3554 (delete-region (planner-line-beginning-position)
3555 (1+ (planner-line-end-position)))
3556 (planner-seek-task-creation-point))
3557 (insert (planner-format-task info nil nil nil nil
3558 (or (planner-make-link page-name) "")
3561 (defalias 'planner-replan-task 'planner-replan-task-basic)
3563 (defun planner-seek-task-creation-point ()
3564 "Jump to point where task would be created."
3565 (planner-seek-to-first (cdr (assoc 'tasks planner-sections)))
3566 (when planner-add-task-at-end-flag
3567 (while (looking-at "^#")
3569 (unless (bolp) (insert "\n"))))
3571 (defun planner-copy-or-move-task-basic (&optional date force)
3572 "Move the current task to DATE.
3573 If this is the original task, it copies it instead of moving.
3574 Most of the time, the original should be kept in a planning file,
3575 but this is not required. If FORCE is non-nil, the task is moved
3576 regardless of status. It also works for creating tasks from a
3577 Note. Use `planner-replan-task' if you want to change the plan
3578 page in order to get better completion.
3579 This function is the most complex aspect of planner.el."
3580 (interactive (list (let ((planner-expand-name-favor-future-p
3581 (or planner-expand-name-favor-future-p
3582 planner-task-dates-favor-future-p)))
3583 (planner-read-date))
3584 current-prefix-arg))
3586 (string-match planner-date-regexp date))
3587 (let ((live-buffers (when (equal planner-tasks-file-behavior 'close)
3589 (when (equal date (planner-page-name))
3590 (error "Cannot move a task back to the same day"))
3592 (save-window-excursion
3595 (let* ((task-info (planner-current-task-info))
3596 (plan-page (planner-task-plan task-info))
3597 (date-page (planner-task-date task-info)))
3599 (error "There is no task on the current line"))
3601 (when (equal date-page date)
3602 (error "Cannot move a task back to the same day"))
3603 (when (equal (planner-task-status task-info) "X")
3604 (error "Cannot reschedule a completed task"))
3605 (when (equal (planner-task-status task-info) "C")
3606 (error "Cannot reschedule a cancelled task")))
3607 (when (and (or (null date) (string= date "nil"))
3609 (error "Cannot unset date in task not associated with plan"))
3610 ;; Delete it from the old date page
3612 (planner-goto date-page)
3613 (goto-char (point-min))
3614 (when (planner-find-task task-info)
3616 (delete-region (point)
3618 (1+ (planner-line-end-position))))))
3619 ;; Update the new date page
3622 (when (or (not planner-copy-or-move-task-suppress-duplicates)
3623 (and (not (planner-find-task task-info))))
3624 (planner-seek-task-creation-point)
3626 (planner-format-task task-info
3629 (planner-make-link plan-page)))
3631 ;; Update planner page
3632 (when (and plan-page
3633 (not (string-match planner-date-regexp plan-page)))
3634 (planner-find-file plan-page)
3635 (goto-char (point-min))
3636 (if (planner-find-task task-info)
3639 (delete-region (point)
3641 (1+ (planner-line-end-position)))))
3642 (planner-seek-task-creation-point))
3643 (insert (planner-format-task
3646 (planner-make-link date)) "\n"))
3648 ;; Operation successful.
3649 (when planner-tasks-file-behavior
3650 (planner-save-buffers live-buffers t)))
3651 (when (planner-replan-task date) t)))
3652 (defalias 'planner-copy-or-move-task 'planner-copy-or-move-task-basic)
3656 (defun planner-delete-task ()
3657 "Deletes this task from the current page and the linked page."
3660 (save-window-excursion
3662 (let* ((task-info (planner-current-task-info))
3663 (task-link (and task-info (planner-task-link task-info)))
3665 (and (equal planner-tasks-file-behavior 'close)
3668 (error "There is no task on the current line"))
3670 (delete-region (point) (min (point-max)
3671 (1+ (planner-line-end-position))))
3672 (when (and task-link (assoc task-link (planner-file-alist))
3673 (planner-jump-to-linked-task task-info))
3674 (delete-region (planner-line-beginning-position)
3675 (min (point-max) (1+ (planner-line-end-position)))))
3676 (when planner-tasks-file-behavior
3677 (planner-save-buffers live-buffers t))))))
3681 (defun planner-edit-task-description-basic (description)
3682 "Change the current task to use DESCRIPTION."
3684 (let* ((info (planner-current-task-info))
3685 (planner-task-history
3687 (planner-task-description info))))
3688 (unless info (error "No task on current line"))
3689 (read-string "New description: "
3690 (cons (planner-task-description info)
3692 '(planner-task-history . 1)
3693 (planner-task-description info)))))
3694 (let ((point (point)))
3695 (with-planner-update-setup
3696 (let ((info (planner-current-task-info))
3698 (equal planner-tasks-file-behavior 'close)
3700 (delete-region (planner-line-beginning-position)
3701 (planner-line-end-position))
3702 (insert (planner-format-task info
3705 (when (planner-task-link info)
3706 (if (planner-jump-to-linked-task info)
3708 (setq info (planner-current-task-info))
3709 (delete-region (planner-line-beginning-position)
3710 (planner-line-end-position))
3711 (insert (planner-format-task info
3714 (planner-seek-task-creation-point)
3716 (planner-format-task info nil nil nil description
3717 (planner-make-link (planner-task-page info)))
3719 (goto-char (point))))
3720 (defalias 'planner-edit-task-description 'planner-edit-task-description-basic)
3723 (defun planner-update-task-basic ()
3724 "Update the current task's priority and status on the linked page.
3725 Tasks are considered the same if they have the same description.
3726 This function allows you to force a task to be recreated if it
3727 disappeared from the associated page.
3729 Note that the text of the task must not change. If you want to be able
3730 to update the task description, see planner-id.el."
3732 (with-planner-update-setup
3734 (let* ((task-info (planner-current-task-info))
3735 (task-link (and task-info
3736 (if (string-match planner-date-regexp
3737 (planner-page-name))
3738 (planner-task-plan task-info)
3739 (planner-task-date task-info))))
3740 (original (planner-page-name)))
3742 (error "There is no task on the current line"))
3743 ;; (unless task-link
3744 ;; (error "There is no link for the current task"))
3745 (if (planner-jump-to-linked-task task-info)
3746 ;; Already there, so update only if changed
3747 (unless (planner-tasks-equal-p task-info
3748 (planner-current-task-info))
3749 (delete-region (planner-line-beginning-position)
3750 (min (point-max) (1+ (planner-line-end-position))))
3751 (insert (planner-format-task task-info nil nil nil nil
3754 ;; Not yet there, so add it
3755 (when (planner-local-page-p task-link)
3756 (planner-find-file task-link)
3759 (planner-seek-task-creation-point)
3761 (planner-format-task task-info nil nil nil nil
3762 (planner-make-link original))
3765 (defalias 'planner-update-task 'planner-update-task-basic)
3769 ;; This really should be called planner-raise/lower-task-priority, but
3770 ;; for some obscure reason, the original planner.el called the task
3771 ;; numbers priorities and "A/B/C" categories. I'm not really sure if I
3772 ;; can change the name right now. I suppose we eventually should.
3774 (defun planner-set-task-priority (priority)
3775 "Set the priority of the current task.
3776 This changes a low-priority task to a medium-priority task
3777 and a medium-priority task to a high-priority task."
3778 (let ((info (planner-current-task-info)))
3780 (delete-region (planner-line-beginning-position)
3781 (min (point-max) (1+ (planner-line-end-position))))
3783 (insert (planner-format-task
3786 (when (planner-task-link info)
3787 (planner-update-task)))))
3789 (defun planner-raise-task-priority ()
3790 "Raise the priority of the current task.
3791 This changes a low-priority task to a medium-priority task
3792 and a medium-priority task to a high-priority task."
3794 (let ((info (planner-current-task-info)))
3796 (delete-region (planner-line-beginning-position)
3797 (min (point-max) (1+ (planner-line-end-position))))
3799 (insert (planner-format-task
3802 ((string= "A" (planner-task-priority info)) "A")
3803 ((string= "B" (planner-task-priority info)) "A")
3804 ((string= "C" (planner-task-priority info)) "B")
3806 (when (planner-task-link info)
3807 (planner-update-task)))))
3809 (defun planner-lower-task-priority ()
3810 "Lower the priority of the current task.
3811 This changes a medium-priority task to a low-priority task
3812 and a high-priority task to a low-priority task."
3814 (let ((info (planner-current-task-info)))
3816 (delete-region (planner-line-beginning-position)
3817 (min (point-max) (1+ (planner-line-end-position))))
3819 (insert (planner-format-task
3822 ((string= "A" (planner-task-priority info)) "B")
3823 ((string= "B" (planner-task-priority info)) "C")
3825 (when (planner-task-link info)
3826 (planner-update-task)))))
3828 (defun planner-raise-task (&optional arg)
3829 "Raise the number of the current task by ARG steps. (Default: 1)"
3832 (setq arg (or arg 1)) ; ARG defaults to 1 if not specified
3833 (if (< arg 0) (planner-lower-task (- arg)))
3834 (let* ((current-task (planner-current-task-info))
3835 ;; task-seen will be the last task moved over with the same link
3837 (unless current-task
3838 (error "Not on a task line"))
3839 ;; Store the current line in the kill ring, deleting it
3840 (kill-region (point) (1+ (planner-line-end-position)))
3841 ;; If the previous line is not a task, search for the previous block
3843 (let ((old-point (point)))
3844 (if (= (forward-line -1) 0)
3845 (if (not (planner-current-task-info))
3846 (if (re-search-backward "^#[ABC][0-9]*[ \t]" nil t)
3848 (setq arg -1) ;; Stop moving, yank back at current place.
3849 (goto-char old-point)))
3850 (setq arg -1)) ;; Stop moving, yank back at current place.
3851 (when (and (> arg 0)
3852 (string= (planner-task-plan current-task)
3853 (planner-task-plan (planner-current-task-info))))
3854 (setq task-seen (planner-current-task-info))))
3855 (setq arg (1- arg)))
3856 ;; Cursor now at right place
3857 (save-excursion (yank))
3858 ;; Update the linked page, if any
3859 (save-window-excursion
3862 (when (and task-seen
3863 (planner-task-link current-task)
3864 (planner-jump-to-linked-task current-task))
3867 (planner-line-beginning-position)
3868 (planner-line-end-position)))
3872 (when (planner-find-task task-seen)
3873 ;; Found the new task, so delete the old task and
3876 (insert old-task "\n"))))
3879 (planner-line-beginning-position)
3880 (1+ (planner-line-end-position)))))))))))
3882 (defun planner-lower-task (&optional arg)
3883 "Lower the number of the current task by ARG steps (default 1)."
3886 (setq arg (or arg 1)) ; ARG defaults to 1 if not specified
3887 (if (< arg 0) (planner-raise-task (- arg)))
3888 (let* ((current-task (planner-current-task-info))
3889 ;; task-seen will be the last task moved over with the same link
3891 (unless current-task
3892 (error "Not on a task line"))
3893 ;; Store the current line in the kill ring, deleting it
3894 (kill-region (point) (1+ (planner-line-end-position)))
3895 ;; If the current line is not a task, search for the next block
3897 (let ((old-point (point)))
3898 (if (not (planner-current-task-info))
3899 (if (re-search-forward "^#[ABC][0-9]*[ \t]" nil t)
3900 (planner-line-beginning-position)
3901 (setq arg -1) ;; Stop moving, yank back at current place.
3902 (goto-char old-point)))
3903 (when (and (> arg 0)
3904 (string= (planner-task-plan current-task)
3905 (planner-task-plan (planner-current-task-info))))
3906 (setq task-seen (planner-current-task-info))))
3907 (unless (and (> arg 0) (= (forward-line 1) 0))
3909 (setq arg (1- arg)))
3910 ;; Cursor now at right place
3911 (save-excursion (yank))
3912 ;; Update the linked page, if any
3913 (save-window-excursion
3916 (when (and task-seen
3917 (planner-task-link current-task)
3918 (planner-jump-to-linked-task current-task))
3921 (planner-line-beginning-position)
3922 (planner-line-end-position)))
3926 (when (planner-find-task task-seen)
3927 ;; Found the new task, so delete the old task and
3931 (insert old-task "\n"))))
3934 (planner-line-beginning-position)
3935 (1+ (planner-line-end-position)))))))))))
3937 ;;;_ + Changing the status
3939 (defvar planner-mark-task-hook nil
3940 "Hook called after a task's status has been changed.
3941 Arguments are OLD-STATUS and NEW-STATUS. Functions should leave
3942 the point on the task. If a function returns nil, no other
3943 functions will be processed.")
3945 (defun planner-mark-task (mark &optional this-only)
3946 "Change task status to MARK.
3947 If THIS-ONLY is non-nil, the linked planner page is not
3949 (let ((case-fold-search nil)
3950 (info (planner-current-task-info)))
3952 (with-planner-update-setup
3953 (goto-char (planner-line-beginning-position))
3954 (skip-chars-forward "^ \t" (planner-line-end-position))
3955 (skip-chars-forward " \t" (planner-line-end-position))
3959 (planner-update-task))
3960 (run-hook-with-args-until-failure
3961 'planner-mark-task-hook
3962 (planner-task-status info)
3965 (defun planner-task-open ()
3966 "Mark the current task as open."
3968 (planner-mark-task "_"))
3970 (defun planner-task-in-progress ()
3971 "Mark the current task as in progress."
3973 (planner-mark-task "o"))
3975 (defun planner-task-done ()
3976 "Mark the current task as done."
3978 (planner-mark-task "X"))
3980 (defun planner-task-cancelled ()
3981 "Mark the current task as cancelled."
3983 (planner-mark-task "C"))
3985 (defun planner-task-delegated ()
3986 "Mark the current task as delegated."
3988 (planner-mark-task "D"))
3990 (defun planner-task-pending ()
3991 "Mark the current task as pending."
3993 (planner-mark-task "P"))
3997 (defun planner-seek-next-unfinished-task ()
3998 "Move point to the next unfinished task on this page.
3999 Return nil if not found."
4001 (re-search-forward "^#[A-C][0-9]*\\s-+[_oDP]\\s-+" nil t))
4003 (defun planner-list-tasks-with-status (status &optional pages)
4004 "Display all tasks that match the STATUS regular expression on all day pages.
4007 nil: check all plan pages
4008 regexp: search all pages whose filenames match the regexp
4009 list of page names: limit to those pages
4010 alist of page/filename: limit to those pages
4011 This could take a long time."
4012 (interactive (list (read-string "Status: ")))
4013 (set-buffer (get-buffer-create "*Planner Tasks*"))
4016 (setq tasks (planner-extract-tasks
4018 (planner-file-alist))
4020 (planner-get-day-pages))
4021 ((not (listp pages))
4022 (let ((regexp pages))
4024 (dolist (page (planner-file-alist))
4025 (when (string-match regexp (cdr page))
4026 (setq pages (cons page pages)))))
4030 (string-match status (planner-task-status item)))))
4033 (format "[[%s]] %s %s %s\n"
4034 (planner-task-page (car tasks))
4035 (planner-task-priority (car tasks))
4036 (planner-task-status (car tasks))
4037 (planner-task-description (car tasks))))
4038 (setq tasks (cdr tasks))))
4040 (setq muse-current-project (muse-project planner-project))
4041 (goto-char (point-min))
4042 (pop-to-buffer (current-buffer)))
4044 (defun planner-list-unfinished-tasks (&optional pages)
4045 "Display all unfinished tasks on PAGES.
4046 The PAGES argument limits the pages to be checked in this manner:
4048 \"regexp\": search all pages whose filenames match \"regexp\"
4049 list of page names: limit to those pages
4050 alist of page/filenames: limit to those pages
4052 Called interactively, this function will search day pages by
4053 default. You can specify the start and end dates or leave them as
4054 nil to search all days. Calling this function with an interactive
4055 prefix will prompt for a regular expression to limit pages.
4056 Specify \".\" or leave this blank to include all pages."
4057 (interactive (list (if current-prefix-arg
4058 (read-string "Regexp: ")
4059 (let ((planner-expand-name-default "nil"))
4060 (planner-get-day-pages
4061 (planner-read-date "nil by default. Start")
4062 (planner-read-date "nil by default. End")
4064 (planner-list-tasks-with-status "[^XC\n]" pages))
4068 (defvar planner-search-notes-buffer "*Planner Search*"
4069 "Buffer for search results.")
4072 (defun planner-search-notes-with-body (regexp limit)
4073 "Return a buffer with all the notes returned by the query for REGEXP.
4074 If called with a prefix argument, prompt for LIMIT and search days on
4075 or after LIMIT. Display the body of the notes as well."
4076 (interactive (list (read-string "Regexp: ")
4077 (if current-prefix-arg
4078 (let ((planner-expand-name-favor-future-p nil))
4079 (planner-read-date)))))
4080 (planner-search-notes regexp limit t))
4083 (defun planner-search-notes (regexp limit &optional include-body)
4084 "Return a buffer with all the notes returned by the query for REGEXP.
4085 If called with a prefix argument, prompt for LIMIT and search days on
4086 or after LIMIT. If INCLUDE-BODY is non-nil, return the body as well."
4087 (interactive (list (read-string "Regexp: ")
4088 (if current-prefix-arg
4089 (let ((planner-expand-name-favor-future-p nil))
4090 (planner-read-date)))
4093 (let* ((case-fold-search t)
4094 (results (planner-search-notes-internal regexp limit include-body)))
4097 (set-buffer (get-buffer-create planner-search-notes-buffer))
4098 (setq buffer-read-only nil)
4104 (planner-make-link (elt item 0)) "\t"
4105 (elt item 2) "\n\n"))
4107 (insert (planner-make-link (elt item 0)) "\t"
4111 (goto-char (point-min))
4112 (pop-to-buffer (current-buffer)))
4113 (message "No results found.")))))
4117 (defun planner-calendar-insinuate ()
4118 "Hook Planner into Calendar.
4120 Adds special planner key bindings to `calendar-mode-map'.
4121 After this function is evaluated, you can use the following
4122 planner-related keybindings in `calendar-mode-map':
4124 n jump to the planner page for the current day.
4125 N display the planner page for the current day."
4128 (add-hook 'calendar-move-hook
4130 (when planner-calendar-show-planner-files
4131 (planner-calendar-show))))
4132 (define-key calendar-mode-map "n" 'planner-calendar-goto)
4133 (define-key calendar-mode-map "N" 'planner-calendar-show))
4134 (defalias 'planner-insinuate-calendar 'planner-calendar-insinuate)
4136 (defvar planner-calendar-buffer-list nil "List of buffers opened by calendar.")
4138 (defun planner-kill-calendar-files ()
4139 "Remove planner files shown from Calendar."
4141 (while planner-calendar-buffer-list
4142 (when (buffer-live-p (car planner-calendar-buffer-list))
4143 (with-current-buffer (car planner-calendar-buffer-list)
4145 (planner-maybe-remove-file)))
4146 (setq planner-calendar-buffer-list (cdr planner-calendar-buffer-list))))
4149 (defun planner-calendar-goto ()
4150 "Goto the plan page corresponding to the calendar date."
4152 (let ((planner-use-other-window t))
4153 (planner-goto (planner-date-to-filename (calendar-cursor-to-date)))))
4156 (defun planner-calendar-show ()
4157 "Show the plan page for the calendar date under point in another window."
4159 (save-selected-window
4160 (let ((planner-use-other-window t)
4161 (date (planner-date-to-filename (calendar-cursor-to-date))))
4162 (if (planner-goto date planner-show-only-existing)
4163 (add-to-list 'planner-calendar-buffer-list (current-buffer))
4164 ;; Return nil or a message if there is no day plan page. planner-goto
4165 ;; is not called interactively, so it doesn't send a message.
4166 (when (interactive-p)
4167 (message "No planner file for %s" date))
4171 (defadvice exit-calendar (after planner activate protect)
4172 "Call `planner-kill-calendar-files'."
4173 (planner-kill-calendar-files))
4175 (defun planner-calendar-select ()
4176 "Return to `planner-read-date' with the date currently selected."
4178 (when (calendar-cursor-to-date)
4179 (setq planner-calendar-selected-date
4180 (planner-date-to-filename (calendar-cursor-to-date)))
4181 (if (active-minibuffer-window) (exit-minibuffer))))
4183 ;;;_* Context-sensitive keybindings
4185 (defun planner-jump-to-link ()
4186 "Jump to the item linked to by the current item."
4189 ((planner-current-task-info) (planner-jump-to-linked-task))
4190 ((planner-current-note-info) (planner-jump-to-linked-note))))
4192 (defun planner-move-up ()
4194 Task: Raise the number of the current task.
4195 Note: Renumbering does not make sense for notes right now, so go to the
4197 Headline: Go to previous headline of the same depth."
4200 ((planner-current-task-info) (planner-raise-task))
4201 ((planner-current-note-info)
4202 (re-search-backward "^\\.#[0-9]+" nil t))
4203 ((and (goto-char (planner-line-beginning-position))
4204 (looking-at "^\\*+"))
4206 (concat "^" (regexp-quote (match-string 0)) "\\s-") nil t))))
4209 (defun planner-move-down ()
4211 Task: Lower the number of the current task.
4212 Note: Renumbering does not make sense for notes right now, so go to the
4214 Headline: Go to the next headline of the same depth."
4217 ((planner-current-task-info) (planner-lower-task))
4218 ((planner-current-note-info)
4220 (re-search-forward "^\\.#[0-9]+" nil t))
4221 ((and (goto-char (planner-line-beginning-position))
4222 (looking-at "^\\*+"))
4225 (concat "^" (regexp-quote (match-string 0)) "\\s-") nil t))))
4227 ;;;_* Initialization
4229 (setq planner-loaded t)
4231 ;; Insinuate with allout mode
4232 (add-hook 'allout-mode-leaders '(planner-mode . "."))
4236 ;;;_* Local emacs vars.
4239 ;; allout-layout: (* 0 : )
4242 ;;; planner.el ends here