planner-multi.el

   1 ;;; planner-multi.el --- Multiple page support for planner.el
   2
   3 ;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
   4
   5 ;; Author: Sandra Jean Chua (Sacha) <sacha AT free.net.ph>
   6
   7 ;; This file is part of Planner.  It is not part of GNU Emacs.
   8
   9 ;; Planner is free software; you can redistribute it and/or modify it
  10 ;; under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; Planner is distributed in the hope that it will be useful, but
  15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 ;; General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with Planner; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  22 ;; Boston, MA 02110-1301, USA.
  23
  24 ;; TODO: completion that makes sense!
  25
  26 ;;; Commentary:
  27
  28 ;; After (require 'planner-multi), you should be able to create tasks
  29 ;; on multiple pages using M-x planner-create-task-from-buffer or M-x
  30 ;; planner-create-task.  Notes should also work if you have at least
  31 ;; remember--dev--1.0--patch-21.
  32
  33 ;;; Contributors:
  34
  35 ;; Jim Ottaway made this work better with planner-appt.el and fixed
  36 ;; several bugs.
  37
  38 ;; Yann Hodique helped in porting this to use Muse rather than
  39 ;; emacs-wiki.
  40
  41 ;; Sergey Vlasov provided a bugfix for lists with dates in them.
  42
  43 ;; Marco Gidde provided a patch that fixes a problem with extraneous
  44 ;; brackets.
  45
  46 ;; Seth Falcon contributed a small improvement to
  47 ;; `planner-multi-replan-task'.
  48
  49 (require 'planner)
  50 (condition-case err
  51     (require 'crm)
  52   ('file-error
  53    (message "Could not load crm; cumbersome completing read used")))
  54
  55 ;;; Code:
  56
  57 (defcustom planner-multi-separator " "
  58   "String that separates multiple page references.
  59 For best results, this should be something recognized by
  60 `muse-link-at-point' so that links are highlighted separately."
  61   :type 'string
  62   :group 'planner)
  63
  64 (defcustom planner-multi-copy-tasks-to-page nil
  65   "If non-nil, planner page to automatically copy tasks to. Example: TaskPool.
  66 You can specify multiple pages by separating them with `planner-multi-separator',
  67 such as \"[[AllTasksByProject][p]] [[AllTasksByContext][c]]\"."
  68   :type 'string
  69   :group 'planner-multi)
  70
  71 (defcustom planner-multi-date-links-last-p t
  72   "If non-nil, put day-page links after other pages on the task line.
  73 Otherwise, put them before other pages on the task line."
  74   :type 'boolean
  75   :group 'planner-multi)
  76
  77 ;;;_+ Utility functions
  78
  79 (defun planner-multi-next-link (current link-list)
  80   "Return the item following CURRENT in LINK-LIST."
  81   (setq current (or current (planner-page-name)))
  82   (let ((found nil)
  83         (search link-list))
  84     (while (and (car search) (null found))
  85       (when (string= (planner-link-base (car search))
  86                      current)
  87         (setq found (car (cdr search))))
  88       (setq search (cdr search)))
  89     (or found (car link-list))))
  90
  91 (defun planner-multi-make-link (list)
  92   "Create a text link for LIST."
  93   (mapconcat 'planner-make-link
  94              list
  95              planner-multi-separator))
  96
  97 (defun planner-multi-link-member (page links)
  98   "Return non-nil if PAGE is a member of LINKS."
  99   (let (found)
 100     (while (and (car links) (null found))
 101       (when (string= (planner-link-base (car links))
 102                      page)
 103         (setq found (car links)))
 104       (setq links (cdr links)))
 105     found))
 106
 107 (defun planner-multi-link-delete (page links)
 108   "Delete PAGE from LINKS."
 109   (let (results)
 110     (while links
 111       (unless (string= (planner-link-base (car links))
 112                        page)
 113         (setq results (cons (car links) results)))
 114       (setq links (cdr links)))
 115     (nreverse results)))
 116
 117 (defun planner-multi-split (string)
 118   "Return a list of links in STRING."
 119   ;; "[[foo bar]] baz [[qux quux]]" should return ("[[foo bar]]" "baz" "[[qux quux]]"), so a simple split-string won't do
 120   (if (stringp string)
 121       (let (list
 122             (pos 0)
 123             (len (length string)))
 124         (while (< pos len)
 125           (if (string-match
 126                (concat (if (= (aref string pos) ?\[)
 127                            "\\(\\[\\[.+?\\]\\]\\)"
 128                          "\\(.*?\\)")
 129                        (regexp-quote planner-multi-separator)
 130                        "+")
 131                string pos)
 132               (progn
 133                 (add-to-list 'list (match-string 1 string) t)
 134                 (setq pos (match-end 0)))
 135             (add-to-list 'list (substring string pos) t)
 136             (setq pos len)))
 137         list)
 138     string))
 139
 140 ;;;_+ Tasks
 141
 142 (defadvice planner-task-info-from-string (after planner-multi activate)
 143   "Store split task strings in position 5 (`planner-task-link')."
 144   (when ad-return-value
 145     (let ((sub-list (cdr (cdr (cdr (cdr (cdr ad-return-value))))))
 146           links)
 147       (when (car (cdr sub-list))
 148         (setq links (planner-multi-split (car (cdr sub-list)))))
 149       (unless (planner-multi-link-member (planner-page-name) links)
 150         (add-to-list 'links (planner-page-name)))
 151       (setcar sub-list links))))
 152
 153 (defadvice planner-task-link (around planner-multi activate)
 154   "Return the next link of a task for compatibility with old code."
 155   (setq ad-return-value
 156         (if (listp (nth 5 info))
 157             (let ((link (planner-multi-next-link (planner-page-name) (nth 5 info))))
 158               (when link (planner-link-base link)))
 159           (nth 5 info))))
 160
 161 (defadvice planner-task-plan (around planner-multi activate)
 162   "Return the first plan of a task for compatibility with old code."
 163   (if (and (nth 5 info) (listp (nth 5 info)))
 164       (let ((current (nth 5 info)))
 165         (while current
 166           (unless (string-match planner-date-regexp (planner-link-base (car current)))
 167             (setq ad-return-value (planner-link-base (car current)))
 168             (setq current nil))
 169           (setq current (cdr current))))
 170     ad-do-it))
 171
 172 (defun planner-multi-task-date (info)
 173   "Return the date assigned to a task given INFO."
 174   (or (let ((date (nth 8 info)))
 175         (and (stringp date)
 176              (string-match planner-date-regexp date)
 177              date))
 178       (let ((links (nth 5 info))
 179             found-date)
 180         (when (listp links)
 181           (while links
 182             (let ((page (planner-link-base (car links))))
 183               (if (string-match planner-date-regexp page)
 184                   (setq found-date page
 185                         links nil)
 186                 (setq links (cdr links)))))
 187           found-date))))
 188 (defalias 'planner-task-date 'planner-multi-task-date)
 189
 190 (defun planner-multi-task-link-as-list (info)
 191   "Return the page links of INFO as a list."
 192   (if (listp (nth 5 info))
 193       (nth 5 info)
 194     (list (nth 5 info))))
 195 (defalias 'planner-task-link-as-list 'planner-multi-task-link-as-list)
 196
 197 (defun planner-multi-task-xref (page)
 198   "Copy the current task to PAGE."
 199   (interactive (list (planner-make-link (planner-read-name (planner-file-alist)))))
 200   (let* ((info (planner-current-task-info))
 201          (links (planner-multi-task-link-as-list info)))
 202     (unless (listp page)
 203       (setq page (planner-multi-split page)))
 204     (while page
 205       (unless (planner-multi-link-member (car page) links)
 206         (add-to-list 'links (car page) t))
 207       (setq page (cdr page)))
 208     (planner-replan-task
 209      (planner-multi-link-delete (planner-task-date info) links))))
 210
 211
 212
 213 (defun planner-multi-copy-or-move-task (&optional date force)
 214   "Move the current task to DATE.
 215 If this is the original task, it copies it instead of moving.
 216 Most of the time, the original should be kept in a planning file,
 217 but this is not required. If FORCE is non-nil, the task is moved
 218 regardless of status. It also works for creating tasks from a
 219 Note. Use `planner-replan-task' if you want to change the plan
 220 page in order to get better completion.
 221 This function is the most complex aspect of planner.el."
 222   (interactive (list (let ((planner-expand-name-favor-future-p
 223                             (or planner-expand-name-favor-future-p
 224                                 planner-task-dates-favor-future-p)))
 225                        (planner-read-date))
 226                      current-prefix-arg))
 227   (let ((info (planner-current-task-info))
 228         (case-fold-search nil))
 229     (if (or (null date)
 230             (string-match planner-date-regexp date))
 231         (if (and (planner-task-link-text info)
 232                  (or (listp (planner-task-link-text info))
 233                      (string-match
 234                       (concat "^\\(" muse-explicit-link-regexp
 235                               "\\|[1-9][0-9][0-9][0-9]\\.[0-9]+\\.[0-9]+"
 236                               "\\)"
 237                               "\\(" (regexp-quote planner-multi-separator)
 238                               "\\(" muse-explicit-link-regexp
 239                               "\\|[1-9][0-9][0-9][0-9]\\.[0-9]+\\.[0-9]+"
 240                               "\\)\\)+$")
 241                       (planner-task-link-text info))))
 242             (progn
 243               (when (equal date (planner-page-name))
 244                 (error "Cannot move a task back to the same day"))
 245               (unless force
 246                 (when (equal (planner-task-date info) date)
 247                   (error "Cannot move a task back to the same day"))
 248                 (when (equal (planner-task-status info) "X")
 249                   (error "Cannot reschedule a completed task"))
 250                 (when (equal (planner-task-status info) "C")
 251                   (error "Cannot reschedule a cancelled task")))
 252               ;; Multiple pages
 253               (with-planner-update-setup
 254                ;; Delete from date page
 255                (let ((old-date (planner-task-date info))
 256                      (links (planner-multi-split
 257                              (planner-task-link-text info))))
 258                  (when old-date
 259                    (planner-find-file (planner-link-base old-date))
 260                    (planner-find-task info)
 261                    (delete-region (planner-line-beginning-position)
 262                                   (min (point-max)
 263                                        (1+ (planner-line-end-position)))))
 264                  ;; Update
 265                  (setq links (planner-multi-link-delete
 266                               (planner-task-date info) links))
 267                  (planner-find-file (planner-link-base (car links)))
 268                  (when date (setq links (cons date links)))
 269                  (if (planner-find-task info)
 270                      (delete-region (planner-line-beginning-position)
 271                                     (min (point-max)
 272                                          (1+ (planner-line-end-position))))
 273                    (planner-seek-task-creation-point))
 274                  (insert (planner-format-task info nil nil nil nil
 275                                               (planner-multi-make-link links))
 276                          "\n")
 277                  (forward-char -1)
 278                  ;; Update all linked tasks
 279                  (planner-update-task))))
 280           (planner-copy-or-move-task-basic date force))
 281       (when (planner-replan-task date) t))))
 282 (defalias 'planner-copy-or-move-task 'planner-multi-copy-or-move-task)
 283
 284 (defun planner-multi-task-string (info page-name links &optional new-pages)
 285   "Return task line for INFO on PAGE-NAME with LINKS, a list of pages to link to.
 286 If non-nil, PAGES should be a list of the `planner-link-base's of LINKS."
 287   ;; Set up the new links list for easy testing
 288   (setq new-pages (mapcar 'planner-link-base links))
 289   (cond
 290    ;; If this is a no-link task
 291    ((and (= (length new-pages) 1)
 292          (string= (car new-pages) page-name))
 293     (planner-format-task info nil nil nil nil "" ""))
 294    ;; If this is a standard singly-linked task (date, plan)
 295    ((and (= (length new-pages) 2)
 296          (string-match planner-date-regexp (car new-pages))
 297          (not (string-match planner-date-regexp (cadr new-pages))))
 298     (planner-format-task info nil nil nil nil
 299                          (planner-make-link
 300                           (if (string-match planner-date-regexp page-name)
 301                               (cadr new-pages)
 302                             (car new-pages)))))
 303    ;; If this is a standard singly-linked task (plan, date)
 304    ((and (= (length new-pages) 2)
 305          (not (string-match planner-date-regexp (car new-pages)))
 306          (string-match planner-date-regexp (cadr new-pages)))
 307     (planner-format-task info nil nil nil nil
 308                          (planner-make-link
 309                           (if (string-match planner-date-regexp page-name)
 310                               (car new-pages)
 311                             (cadr new-pages)))))
 312    ;; Multilink
 313    (t (planner-format-task info nil nil nil nil
 314                            (planner-make-link new-pages)))))
 315
 316 (defun planner-multi-replan-task (pages)
 317   "Change or assign the plan page for the current task.
 318 PAGES is the new plan page for the task. Use
 319 `planner-copy-or-move-task' if you want to change the date.
 320 With a prefix, provide the current link text for editing."
 321   (interactive (list
 322                 (planner-read-name
 323                  (planner-file-alist) nil
 324                  ;; The list of planner pages associated with this task
 325                  (when current-prefix-arg
 326                    (planner-multi-make-link
 327                     (planner-multi-filter-links
 328                      planner-date-regexp
 329                      (planner-multi-task-link-as-list
 330                       (planner-current-task-info))
 331                      t))))))
 332   (when (stringp pages) (setq pages (planner-multi-split pages)))
 333   (let* ((info (planner-current-task-info))
 334          (old-pages
 335           ;; Pages the task is currently assigned to
 336           (planner-multi-task-link-as-list info))
 337          new-pages
 338          date) ; Pages from page-name
 339     ;; Add dates back to the list of pages
 340     (setq date (planner-task-date info))
 341     (when date (add-to-list 'pages date planner-multi-date-links-last-p))
 342     (unless pages
 343       (error "Cannot replan this task; it will disappear"))
 344     (with-planner-update-setup
 345      ;; Set up the new links list for easy testing
 346      (setq new-pages (mapcar 'planner-link-base pages))
 347      ;; Map over the old pages, removing if not in the new one and
 348      ;; updating if it is
 349      (while old-pages
 350        (planner-find-file (car old-pages))
 351        (cond
 352         ((planner-find-task info)
 353          (delete-region (planner-line-beginning-position)
 354                         (1+ (planner-line-end-position))))
 355         ((member (planner-page-name) new-pages)
 356          (planner-seek-task-creation-point)))
 357        (when (member (planner-page-name) new-pages)
 358          (insert (planner-multi-task-string info (planner-page-name) pages new-pages) "\n"))
 359        (setq old-pages (cdr old-pages)))
 360     ;; Map over any new pages that were not included
 361     (setq old-pages (mapcar 'planner-link-base (planner-multi-task-link-as-list info)))
 362     (mapcar (lambda (page)
 363               (unless (member page old-pages)
 364                 (planner-find-file page)
 365                 (if (planner-find-task info)
 366                     (delete-region (planner-line-beginning-position)
 367                                    (1+ (planner-line-end-position)))
 368                   (planner-seek-task-creation-point))
 369                 (insert (planner-multi-task-string info (planner-page-name) pages new-pages) "\n")))
 370             new-pages))))
 371
 372 (defalias 'planner-replan-task 'planner-multi-replan-task)
 373
 374 (defun planner-multi-update-task ()
 375   "Update the current task's priority and status on the linked page.
 376 Tasks are considered the same if they have the same description.
 377 This function allows you to force a task to be recreated if it
 378 disappeared from the associated page.
 379
 380 Note that the text of the task must not change.  If you want to be able
 381 to update the task description, see planner-id.el."
 382   (interactive)
 383   (let* ((info (planner-current-task-info))
 384          (links (planner-multi-task-link-as-list info))
 385          (new-pages (mapcar 'planner-link-base links)))
 386     ;; Jump around
 387     (with-planner-update-setup
 388      (while links
 389        (planner-find-file (planner-link-base (car links)))
 390        (if (planner-find-task info)
 391            ;; Already there, so update only if changed
 392            (unless (planner-tasks-equal-p info
 393                                           (planner-current-task-info))
 394              (delete-region (planner-line-beginning-position)
 395                             (planner-line-end-position))
 396              (insert (planner-multi-task-string info (planner-page-name)
 397                                                 (planner-multi-task-link-as-list info)
 398                                                 new-pages)))
 399            ;; Not yet there, so add it
 400            (planner-seek-task-creation-point)
 401            (insert (planner-multi-task-string info (planner-page-name)
 402                                               (planner-multi-task-link-as-list info)
 403                                               new-pages) "\n"))
 404          (setq links (cdr links))))))
 405 (defalias 'planner-update-task 'planner-multi-update-task)
 406
 407 (defun planner-multi-tasks-equal-p (task-a task-b)
 408   "Return t if TASK-A and TASK-B are equivalent.
 409 This is true if they have the same value for priority, status,
 410 description, and links."
 411   (and (string= (or (planner-task-priority task-a) "")
 412                 (or (planner-task-priority task-b) ""))
 413        (string= (or (planner-task-status task-a) "")
 414                 (or (planner-task-status task-b) ""))
 415        (string= (or (planner-task-description task-a) "")
 416                 (or (planner-task-description task-b) ""))
 417        (if (or (string-match (regexp-quote planner-multi-separator)
 418                              (or (planner-task-link-text task-a) ""))
 419                (string-match (regexp-quote planner-multi-separator)
 420                              (or (planner-task-link-text task-b) "")))
 421            (string= (planner-task-link-text task-a)
 422                     (planner-task-link-text task-b))
 423          (and (string= (or (planner-task-plan task-a) "")
 424                        (or (planner-task-plan task-b) ""))
 425               (string= (or (planner-task-date task-a) "")
 426                        (or (planner-task-date task-b) ""))))))
 427 (defalias 'planner-tasks-equal-p 'planner-multi-tasks-equal-p)
 428
 429 (defadvice planner-delete-task (around planner-multi activate)
 430   "Remove this note from all linked pages."
 431   ;; Delete the current note.
 432   (save-window-excursion
 433     (let ((info (planner-current-task-info))
 434           links)
 435       (setq links (planner-multi-task-link-as-list info))
 436       (if (<= (length links) 1)
 437           ad-do-it
 438         (while links
 439           (planner-find-file (planner-link-base (car links)))
 440           (when (planner-find-task info)
 441             (delete-region (planner-line-beginning-position)
 442                            (min (point-max) (1+ (planner-line-end-position)))))
 443           (setq links (cdr links)))))))
 444
 445 (defadvice planner-make-link (around planner-multi activate)
 446   "Escape separately if using `planner-multi-separator'."
 447   (if (ad-get-arg 2)
 448       ad-do-it
 449     (let ((case-fold-search nil))
 450       (cond
 451        ((listp link)
 452         (setq ad-return-value (mapconcat 'muse-make-link
 453                                          link
 454                                          planner-multi-separator)))
 455        ((string-match (regexp-quote planner-multi-separator) link)
 456         (setq ad-return-value (mapconcat 'muse-make-link
 457                                          (planner-multi-split link)
 458                                          planner-multi-separator)))
 459        (t ad-do-it)))))
 460
 461 (defun planner-multi-filter-links (regexp links-list &optional nonmatch)
 462   "Return a list of links matching REGEXP in LINKS-LIST.
 463 If NONMATCH is non-nil, return non-matching links instead."
 464   (delq nil
 465         (mapcar (lambda (item)
 466                   (when (funcall (if nonmatch 'not 'null)
 467                                  (string-match regexp item))
 468                     item))
 469                 links-list)))
 470
 471 (defun planner-multi-create-task-from-info (info &optional priority number status description link-text date plan)
 472   "Create a task in the date and plan pages based on INFO.
 473 Optional arguments PRIORITY, NUMBER, STATUS, DESCRIPTION,
 474 LINK-TEXT, DATE, and PLAN override those in INFO.
 475 Create task on multiple pages if necessary."
 476   (setq link-text (or link-text (planner-task-link-text info)))
 477   (when planner-multi-copy-tasks-to-page
 478     (if (and link-text planner-multi-copy-tasks-to-page)
 479         (unless (string-match (regexp-quote (planner-link-base planner-multi-copy-tasks-to-page)) link-text)
 480           (setq link-text (concat link-text planner-multi-separator planner-multi-copy-tasks-to-page)))
 481       (setq link-text planner-multi-copy-tasks-to-page)))
 482   (if (and link-text
 483            (string-match (regexp-quote planner-multi-separator) link-text))
 484       (progn
 485         ;; Create the task on all pages.
 486         (let ((list (planner-multi-split (or link-text (planner-task-link-text info))))
 487               (link-text (or link-text (planner-task-link-text info))))
 488           (when (or date (planner-task-date info))
 489             (setq list (planner-multi-filter-links
 490                         planner-date-regexp
 491                         list
 492                         t))
 493             (add-to-list 'list (or date (planner-task-date info))
 494                          planner-multi-date-links-last-p)
 495             (setq link-text (planner-multi-make-link list)))
 496           (save-window-excursion
 497             (while list
 498               (planner-find-file (planner-link-base (car list)))
 499               (planner-seek-task-creation-point)
 500               (insert (planner-format-task info priority number status description link-text)
 501                       "\n")
 502               (setq list (cdr list)))
 503             (forward-line -1)
 504             (run-hooks 'planner-create-task-hook))))
 505     (planner-create-task-from-info-basic info priority number status
 506                                          description link-text date plan)))
 507 (setq planner-create-task-from-info-function 'planner-multi-create-task-from-info)
 508
 509 (defun planner-multi-task-delete-this-page ()
 510   "Remove this task from the current page."
 511   (interactive)
 512   (let ((info (planner-current-task-info)))
 513     (planner-multi-replan-task
 514      (planner-multi-link-delete
 515       (planner-task-date info)
 516       (planner-multi-link-delete (planner-page-name)
 517                                  (planner-multi-task-link-as-list
 518                                   (planner-current-task-info)))))))
 519
 520
 521 (defun planner-multi-edit-task-description (description)
 522   "Update multiple pages."
 523   (interactive (list
 524                 (let* ((info (planner-current-task-info))
 525                        (planner-task-history
 526                         (list
 527                          (planner-task-description info))))
 528                   (unless info (error "No task on current line"))
 529                   (read-string "New description: "
 530                                (cons (planner-task-description info)
 531                                      1)
 532                                '(planner-task-history . 1)
 533                                (planner-task-description info)))))
 534   (let ((point (point)))
 535     (with-planner-update-setup
 536      (let* ((info (planner-current-task-info))
 537             (newinfo (planner-current-task-info))
 538             (links (planner-multi-task-link-as-list info))
 539             (new-pages (mapcar 'planner-link-base links)))
 540        (setcar (cdr (cdr (cdr (cdr newinfo))))
 541                description)
 542        (while links
 543          (planner-find-file (planner-link-base (car links)))
 544          (if (planner-find-task info)
 545              ;; Already there, so update only if changed
 546              (delete-region (planner-line-beginning-position)
 547                             (min (point-max)
 548                                  (1+ (planner-line-end-position))))
 549            ;; Not yet there, so add it
 550            (planner-seek-task-creation-point))
 551          (insert (planner-multi-task-string
 552                   newinfo (planner-page-name)
 553                   (planner-multi-task-link-as-list info)
 554                   new-pages)
 555                  "\n")
 556          (setq links (cdr links)))))
 557     (goto-char point)))
 558 (defalias 'planner-edit-task-description 'planner-multi-edit-task-description)
 559
 560 ;; Todo: copy-or-move
 561
 562 ;;;_+ Notes
 563
 564 (defadvice planner-current-note-info (after planner-multi activate)
 565   "Store split note strings in position 4 (`planner-note-link')."
 566   (let ((sub-list (cdr (cdr (cdr (cdr ad-return-value))))))
 567     (when (and (car sub-list) (string-match (regexp-quote planner-multi-separator) (car sub-list)))
 568       (setcar sub-list (planner-multi-split (car sub-list))))))
 569
 570 (defadvice planner-note-link (around planner-multi activate)
 571   "Return the next link of a note for compatibility with old code."
 572   (setq ad-return-value
 573         (if (and (nth 4 note-info) (listp (nth 4 (ad-get-arg 0))))
 574             (planner-multi-next-link (planner-page-name) (nth 4 (ad-get-arg 0)))
 575           (nth 4 note-info))))
 576
 577 (defadvice planner-note-link-text (around planner-multi activate)
 578   "Return the link text of a note for compatibility with old code."
 579   (setq ad-return-value
 580         (if (and (nth 4 note-info) (listp (nth 4 (ad-get-arg 0))))
 581             (planner-make-link (nth 4 note-info))
 582           (nth 4 note-info))))
 583
 584 (defun planner-multi-note-link-as-list (info)
 585   "Return the page links of INFO as a list."
 586   (if (listp (nth 4 info))
 587       (nth 4 info)
 588     (list (nth 4 info))))
 589
 590 (defadvice planner-update-note (around planner-multi activate)
 591   "Copy the text from this note to the linked notes, if any."
 592   (interactive)
 593   (let ((info (planner-current-note-info))
 594         body)
 595     (if (= (length (planner-multi-note-link-as-list info)) 1)
 596         ad-do-it
 597       (save-window-excursion
 598         (save-restriction
 599           (planner-narrow-to-note)
 600           (goto-char (point-min))
 601           (skip-chars-forward ".#0-9")
 602           (setq body (buffer-substring-no-properties (point) (point-max))))
 603         (let ((links (planner-multi-note-link-as-list info)))
 604           ;; Jump around
 605           (while links
 606             (planner-visit-link (planner-link-target (car links)))
 607             (save-restriction
 608               (when (planner-narrow-to-note)
 609                 (goto-char (point-min))
 610                 (skip-chars-forward ".#0-9")
 611                 (delete-region (point) (point-max))
 612                 (insert body)))
 613             (setq links (cdr links))))))))
 614
 615 (defun planner-multi-note-xref (page)
 616   "Copy the current note to PAGE."
 617   (interactive (list (planner-read-name (planner-file-alist))))
 618   (let ((case-fold-search nil))
 619     ;; Modify the current note
 620     (save-window-excursion
 621       (when (planner-current-note-info)
 622         (let (note-num)
 623           (save-window-excursion
 624             (setq note-num (planner-create-note page)))
 625           ;; Add to current
 626           (unless (looking-at "^.#[0-9]")
 627             (re-search-backward "^.#[0-9]" nil t))
 628           (cond
 629            ;; Already a multilink
 630            ((re-search-forward (concat
 631                                 "("
 632                                 "\\(" muse-explicit-link-regexp "\\)"
 633                                 "\\("
 634                                 (regexp-quote planner-multi-separator)
 635                                 "\\("
 636                                 muse-explicit-link-regexp
 637                                 "\\)\\)+)") (planner-line-end-position) t)
 638             (forward-char -1)
 639             (insert planner-multi-separator
 640                     (planner-make-link (concat page "#"
 641                                                (number-to-string note-num)))))
 642            ;; Single link
 643            ((re-search-forward (concat "(\\("
 644                                        muse-explicit-link-regexp
 645                                        "\\))")
 646                                (planner-line-end-position) t)
 647             (forward-char -1)
 648             (insert planner-multi-separator
 649                     (planner-make-link (concat page "#"
 650                                                (number-to-string note-num)))
 651                     planner-multi-separator
 652                     (planner-make-link (concat (planner-page-name) "#"
 653                                                (planner-note-anchor (planner-current-note-info))))))
 654            ;; No link yet
 655            (t
 656             (re-search-forward "\\s-*$" (planner-line-end-position) t)
 657             (replace-match
 658              (concat " ("
 659                      (save-match-data
 660                        (planner-make-link (concat page "#"
 661                                                   (number-to-string note-num))))
 662                      ")")
 663              t t)))
 664           (planner-update-note))))))
 665
 666 (defadvice planner-replan-note (around planner-multi activate)
 667   "Allow multiple pages."
 668   (if (string-match (regexp-quote planner-multi-separator) page)
 669       (save-window-excursion
 670         (save-restriction
 671           (let* ((info (planner-current-note-info))
 672                  (links (planner-multi-note-link-as-list info))
 673                  (new-links (planner-multi-split page))
 674                  (old-anchor (planner-make-link
 675                               (concat (planner-note-page info) "#"
 676                                       (planner-note-anchor info))))
 677                  cursor
 678                  current-page
 679                  (old-pages (mapcar 'planner-link-base links)))
 680             (when (and (not old-pages)
 681                        (string-match planner-date-regexp (planner-note-page info)))
 682               (setq old-pages (list (planner-note-page info)))
 683               (add-to-list 'new-links old-anchor))
 684             ;; Add to new pages
 685             (setq cursor new-links)
 686             (while cursor
 687               (setq current-page (planner-link-base (car cursor)))
 688               (when (not (member current-page old-pages))
 689                 (setcar cursor
 690                         (planner-make-link
 691                          (format "%s#%d"
 692                                  (planner-link-base (car cursor))
 693                                  (planner-create-note current-page)))))
 694               (setq cursor (cdr cursor)))
 695             ;; Delete from pages removed from list
 696             (setq cursor links)
 697             (while cursor
 698               (unless (member (planner-link-base (car cursor)) old-pages)
 699                 (planner-visit-link (planner-link-target (car links)))
 700                 (save-restriction
 701                   (when (planner-narrow-to-note)
 702                     (delete-region (point-min) (point-max)))))
 703               (setq cursor (cdr cursor)))
 704             ;; Update the current note
 705             (planner-visit-link (concat (planner-note-page info)
 706                                         "#" (planner-note-anchor info)))
 707             (delete-region (1+ (point)) (planner-line-end-position))
 708             (insert " " (planner-format-note info "" nil nil (planner-make-link
 709                                                               new-links)))
 710             (planner-update-note))))
 711     ad-do-it))
 712
 713 (defun planner-multi-note-delete ()
 714   "Remove this note from all linked pages."
 715   (interactive)
 716   ;; Delete the current note.
 717   (save-window-excursion
 718     (let ((info (planner-current-note-info))
 719           links)
 720       (when info
 721         (setq links (planner-multi-note-link-as-list info))
 722         (while links
 723           (planner-visit-link (planner-link-target (car links)))
 724           (save-restriction
 725             (planner-narrow-to-note)
 726             (delete-region (point-min) (point-max)))
 727           (setq links (cdr links)))))))
 728
 729 (defun planner-multi-note-delete-this-page ()
 730   "Remove this note from the current page."
 731   (interactive)
 732   ;; Delete the current note.
 733   (save-window-excursion
 734     (let* ((info (planner-current-note-info))
 735            new-link
 736            new-link-list)
 737       (when info
 738         (setq new-link-list
 739               (planner-multi-link-delete
 740                (planner-page-name)
 741                (planner-multi-note-link-as-list info)))
 742         (setq new-link (planner-multi-make-link new-link-list))
 743         (save-restriction
 744           (planner-narrow-to-note)
 745           (delete-region (point-min) (point-max)))
 746         (while new-link-list
 747           (planner-visit-link (planner-link-target (car new-link-list)))
 748           (when (re-search-forward (concat
 749                                     "("
 750                                     "\\(" muse-explicit-link-regexp "\\)"
 751                                     "\\("
 752                                     (regexp-quote planner-multi-separator)
 753                                     "\\("
 754                                     muse-explicit-link-regexp
 755                                     "\\)\\)+)")
 756                                    (planner-line-end-position)
 757                                    t)
 758             (replace-match
 759              (if (string= new-link "") ""
 760                (concat "(" new-link ")"))
 761              t t))
 762           (setq new-link-list (cdr new-link-list)))))))
 763
 764 (defalias 'planner-multi-xref-note 'planner-multi-note-xref)
 765 (defalias 'planner-multi-delete-note 'planner-multi-note-delete)
 766 (defalias 'planner-multi-delete-note-this-page 'planner-multi-note-delete-this-page)
 767 (defalias 'planner-multi-xref-task 'planner-multi-task-xref)
 768 (defalias 'planner-multi-delete-task-this-page 'planner-multi-task-delete-this-page)
 769
 770 (defun planner-multi-read-name (file-alist &optional prompt initial)
 771   "Read multiple pages, completing based on FILE-ALIST.
 772 If PROMPT is specified, use that instead of \"Page:\"."
 773   (let* ((minibuffer-prompt-properties
 774           (plist-put
 775            (copy-sequence minibuffer-prompt-properties)
 776            'read-only nil))
 777          (map (copy-keymap minibuffer-local-completion-map))
 778          (completion-ignore-case t)
 779          (crm-separator (regexp-quote planner-multi-separator))
 780          (prompt (format "%s(default: %s) "
 781                          (or prompt "Page: ") planner-default-page))
 782          str)
 783     (unwind-protect
 784         (progn
 785           (define-key minibuffer-local-completion-map
 786             planner-multi-separator 'self-insert-command)
 787           (setq str
 788                 (if (fboundp 'completing-read-multiple)
 789                     (completing-read-multiple
 790                      prompt file-alist nil nil initial
 791                      'planner-history-list
 792                      planner-default-page)
 793                   (planner-multi-split
 794                    (read-string prompt initial 'planner-history-list
 795                                 planner-default-page))))
 796           (cond
 797            ((or (null str)
 798                 (string= (car str) "")) planner-default-page)
 799            ((string= (car str) "nil") nil)
 800            (t (mapconcat 'identity str planner-multi-separator))))
 801       (setq minibuffer-local-completion-map map))))
 802
 803 (defun planner-multi-read-name-multiple-prompts (file-alist prompt initial)
 804   "Read multiple pages, completing based on FILE-ALIST.
 805 If PROMPT is specified, use that instead of \"Page:\".
 806 Enter one plan page at a time. To end input, type \"nil\"."
 807   (let ((more t)
 808         input
 809         last
 810         list)
 811     (while more
 812       (setq input
 813             (planner-read-name-single file-alist
 814                                       (concat "nil to stop. " (or prompt "Page: "))
 815                                       initial))
 816       (setq planner-default-page nil initial nil)
 817       (if input
 818           (add-to-list 'list input t)
 819         (setq more nil)))
 820     (setq planner-default-page (planner-multi-make-link list))))
 821
 822 (if (fboundp 'completing-read-multiple)
 823     (setq planner-read-name-function 'planner-multi-read-name)
 824   (setq planner-read-name-function 'planner-multi-read-name-multiple-prompts))
 825
 826 ;;;###autoload
 827 (defun planner-multi-remove-task-from-pool (old-status new-status)
 828   "Remove completed tasks from `planner-multi-copy-tasks-to-page' if that still leaves them linked."
 829   (when (and planner-multi-copy-tasks-to-page
 830              (or (string= new-status "C")
 831                  (string= new-status "X")))
 832     (let ((info (planner-current-task-info)))
 833       (when (planner-task-link-text info)
 834         ;; If it is linked to TaskPool _and_ at least one other thing
 835         (cond
 836          ((string-match planner-multi-separator (planner-task-link-text info))
 837           (let ((remove-from
 838                  (mapcar 'planner-link-base (planner-multi-split planner-multi-copy-tasks-to-page)))
 839                 new-links)
 840             (setq new-links
 841                   (delq nil
 842                         (mapcar (lambda (item)
 843                                   (unless (member (planner-link-base item) remove-from)
 844                                     (planner-link-base item)))
 845                              (planner-multi-task-link-as-list info))))
 846             (save-excursion
 847               (planner-replan-task (mapconcat 'identity new-links planner-multi-separator)))
 848             ;; Make sure we are on the same task
 849             (when (string= (planner-page-name) planner-multi-copy-tasks-to-page)
 850               (planner-find-file (car new-links))
 851               (planner-find-task info))))
 852           ;; Else if it has a date and is linked to TaskPool
 853          ((and (planner-task-date info)
 854                (string= (planner-task-plan info) planner-multi-copy-tasks-to-page)
 855           (save-excursion (planner-replan-task nil))
 856           (when (string= (planner-page-name) planner-multi-copy-tasks-to-page)
 857             (planner-find-file (planner-task-date info))
 858             (planner-find-task info))))))))
 859   t)
 860
 861 (add-hook 'planner-mark-task-hook 'planner-multi-remove-task-from-pool t)
 862
 863 (provide 'planner-multi)
 864
 865 ;;; planner-multi.el ends here