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