[emacs-wiki-discuss] Re: Archiving?

[Andrew J. Korty]

Gregory Novak <address@hidden> writes:

> I've been using PlannerMode for about a year now with some degree of
> success.  One thing that's getting me down is that now my directory is
> filled with a zillion little files... one for each day, at least.
> There are also a fairly large number of files for projects which were
> finished or became irrelevant months ago.  It would be nice if there
> were a way to archive things without breaking the links.  For example,
> all the 2005.* pages, along with perhaps all of the project pages for
> which all tasks are completed, would be moved into a directory called
> '2005.'  

I wrote some pretty immature code to archive a given project page.  I
keep meaning to make it more robust so I can run it on an entire
planner hierarchy, but here it is in its current form.

-- 
Andrew J. Korty, Chief Security Engineer, GCIA, GCFA
Office of the Vice President for Information Technology
Indiana University

- --=-=-Content-Type: application/emacs-lisp
Content-Disposition: attachment; filename=planner-archive.el
Content-Transfer-Encoding: quoted-printable
Content-Description: planner-archive.el

(defun planner-archive-transform-links (links &optional date new-page
                                             remove-day-links)
  "Traverse the list LINKS, transforming any link to the current page into a 
link to a page named for the current page and today's date.
The new page's name is of the form PAGE-YYYY.MM.DD."
  (unless date
    (setq date (format-time-string "%Y.%m.%d")))
  (unless (listp links)
    (setq links (list links)))
  (let ((current-page (planner-page-name))
        new-links)
    (while links
      (cond

       ;; rename this page's links
       ((string= current-page (planner-link-base (car links)))
        (setq new-links
              (cons 
               (concat "[["
                       (cond ((functionp new-page)
                              (funcall new-page date))
                             ((null new-page)
                              (concat current-page "-" date))
                             ((t new-page)))
                       (let ((anchor (planner-link-anchor (car links))))
                         (if anchor
                             (concat "#" anchor)
                           ""))
                       "]]")
               new-links)))

       ;; skip date links
       ((and remove-day-links (string-match planner-date-regexp (car links))))

       ;; add all other links to the new list without changes
       (t (setq new-links (cons (car links) new-links))))

      (setq links (cdr links)))

    new-links))


(defun planner-archive-notes (&optional date new-page)
  "Move all notes older than DATE on the current page to NEW-PAGE.
If NEW-PAGE is unspecified, notes are moved to a page named for the
current page and today's date.  The new page's name is of the form
PAGE-YYYY.MM.DD."
  (interactive)
  (goto-char (point-max))
  (while (re-search-backward "^\\.#[0-9]+\\s-+" nil t)
    (save-excursion
      (let* ((info (planner-current-note-info))
             (links (nth 4 info)))
        (when (or (null date)
                  (string< (planner-note-date info) date))
          (planner-replan-note
           (mapconcat
            'identity
            (planner-archive-transform-links links date new-page)
            " "))
          (planner-delete-note))))))

(defun planner-archive-tasks (&optional date new-page)
  "Move all completed or cancelled tasks older than DATE (tomorrow if 
unspecified) on the current page to NEW-PAGE.
If NEW-PAGE is unspecified, notes are moved to a page named for the
current page and today's date in the form PAGE-YYYY.MM.DD.  If
NEW-PAGE is a function, it is called with DATE as its only argument,
and its return value is used as the name of the new page."
  (interactive)
  (goto-char (point-min))
  (while (re-search-forward "^#[A-C]" nil t)
    (save-excursion
      (let* ((info (planner-current-task-info))
             (links (planner-task-link-as-list info))
             (status (planner-task-status info)))
        (and (or (equal status "C")
                 (equal status "X"))
             (or (null date)
                 (string< (planner-task-date info) date))
             (planner-replan-task
              (mapconcat
               'identity
               (planner-archive-transform-links links date new-page t)
               " ")))))))

(defun planner-archive (&optional date new-page)
  (interactive)
  (planner-archive-tasks date new-page)
  (let (planner-reverse-chronological-notes)
    (planner-archive-notes date new-page)))

- --=-=-=--
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.2.2 (GNU/Linux)

iD8DBQFEYHm78gM8+Mr5peERAs2IAJ9dP1XeIV2ZOJT0diGn6Loa8yZZRACfS5zw
GJnmVKvwnPsYdLDwPhsha1A=8JtH
-----END PGP SIGNATURE-----