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