;;; mst-planner.el --- Experimentation with Emacs Planner

;; Author: Mark Triggs <mst@dishevelled.net>

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:
;;
;; For a fair while I've been keeping track of my todo list using my trusty
;; ~/.plan file and a whole bunch of ticked messages in Gnus.  My usual method
;; for deciding what to do next is to pluck the next cryptic note from
;; ~/.plan--which must have made sense when I wrote it--then search through my
;; ticked articles to decipher it.
;;
;; The code I've written here is sort of in the same spirit as that.  I define
;; tasks I want to complete, each with its own page of notes, links to emails
;; and miscellaneous rambling.  I can prioritise my tasks, mark them as "in
;; progress" or "completed".  I've never really bothered aiming for deadlines,
;; so I've excluded that whole business--I keep track of things with M-x diary,
;; and that suits me pretty well.  Maybe I'll want to integrate that later.
;;

;;; Code:

(require 'planner)
(require 'planner-publish)
(require 'planner-bbdb)
(require 'planner-w3m)
(require 'emacs-wiki)

(defvar *task-index-page* "TaskPool")
(defvar *planner-last-window-config* nil)
(setq planner-plan-page-template "* Notes\n\n")
(setq planner-use-day-pages nil)


(defun mst-planner-save-windows ()
  (setq *planner-last-window-config* (current-window-configuration)))


(defun mst-planner-create-task (title priority &optional noselect)
  (interactive (list (read-from-minibuffer "Title for this task: ")
                      (mst-planner-read-priority)))
  (let ((page (loop for i from (length (directory-files planner-directory)) do
                    (unless (planner-page-exists-p (number-to-string i))
                      (return (number-to-string i))))))
    (with-current-buffer (planner-goto-plan-page page)
      (erase-buffer)
      (insert (format "* %s\n\n" title))
      (save-buffer)
      (kill-buffer nil))
    (planner-create-task-from-info nil priority "0"
                                   planner-default-task-status
                                   (format "[[%s.muse][%s]] (%s)"
                                           page title
                                           (format-time-string "%Y-%m-%d"))
                                   "" nil "TaskPool")
    (unless noselect
      (mst-planner-summary)
      (split-window)
      (other-window 1)
      (planner-goto-plan-page page)
      (goto-char (point-max)))))

(defun mst-planner-move-to-bottom ()
  (save-excursion
    (let ((line (buffer-substring (line-beginning-position)
                                  (line-end-position))))
      (delete-region (line-beginning-position)
                     (line-end-position))
      (delete-char 1)
      (search-forward-regexp "* Completed$")
      (skip-chars-forward "\n")
      (insert (concat line "\n"))
      (backward-char 1)
      (when (= (char-before (point)) (string-to-char ")"))
        (backward-char 1)
        (insert (format "--%s" (format-time-string "%Y-%m-%d")))))))

(defun mst-planner-task-done ()
  (interactive)
  (when (planner-mark-task "X")
    (mst-planner-move-to-bottom)))

(defun mst-planner-task-cancelled ()
  (interactive)
  (when (planner-mark-task "C")
    (mst-planner-move-to-bottom)))


(defun mst-planner-create-task-from-buffer (title &optional noselect)
  (interactive "sTitle for this task: ")
  (let ((xref (mst-planner-xref-as-kill)))
    (mst-planner-create-task title
                             (mst-planner-read-priority)
                             noselect)
    (insert (format "Reference: %s\n" xref))))


(defun mst-planner-xref-as-kill ()
  (interactive)
  (let ((text (run-hook-with-args-until-success
               'planner-annotation-functions)))
    (with-temp-buffer
      (insert text)
      (kill-region (point-min) (point-max)))
    text))


(defun mst-planner-replace-regexps-in-string (replacements string)
  (reduce (lambda (string replacement)
            (replace-regexp-in-string (car replacement) (cadr replacement)
                                      string))
          replacements
          :initial-value string))


(defun mst-planner-read-priority ()
  (completing-read "Priority? "
                   '(("A") ("B") ("C")) nil t
                   planner-default-task-priority))


(defun mst-planner-create-task-from-message ()
  "Create a new task using the current message's subject for its title."
  (interactive)
  (save-window-excursion
    (gnus-summary-select-article nil t)
    (with-current-buffer gnus-article-buffer
      (let ((body (save-restriction
                    (gnus-narrow-to-body)
                    (buffer-string))))
        (mst-planner-create-task
         (mst-planner-replace-regexps-in-string
          '(("\\]" ")") ("\\[" "()") ("^Planner: " ""))
          (message-fetch-field "subject"))
         (mst-planner-read-priority)
         nil)
        (insert body)
        (when (search-backward-regexp "^-- ")
          (delete-region (point) (point-max)))
        (mst-unplanner)))))


(define-key global-map (kbd "C-c p a") 'mst-planner-create-task)
(define-key global-map (kbd "C-c p b") 'mst-planner-create-task-from-buffer)
(define-key global-map (kbd "C-c p m") 'mst-planner-create-task-from-message)
(define-key global-map (kbd "C-c p y") 'mst-planner-xref-as-kill)
(define-key global-map (kbd "C-c p p") 'mst-planner-summary)

(defun mst-planner-summary ()
  (interactive)
  (mst-planner-save-windows)
  (delete-other-windows)
  (planner-goto-plan-page "TaskPool"))

(defun mst-unplanner ()
  (interactive)
  (planner-save-buffers)
  (dolist (buf (buffer-list))
    (with-current-buffer buf
      (when (eq major-mode 'planner-mode)
        (kill-buffer nil))))
  (when *planner-last-window-config*
      (set-window-configuration *planner-last-window-config*)
      (setq *planner-last-window-config* nil)))

(defun mst-planner-garbage-collect ()
  (interactive)
  (save-window-excursion
    (mst-planner-summary)
    (let ((files '()))
      (goto-char (point-min))
      (while (search-forward "[[" nil t)
        (push (remove-properties-from-string (muse-link-at-point)) files))
      (dolist (file (muse-project-file-alist planner-project))
        (let ((filename (file-name-nondirectory (cdr file))))
          (unless (or (member filename files)
                      (not (string-match "^[0-9]+\.muse$" filename)))
            (delete-file (cdr file))))))))

(define-key planner-mode-map (kbd "C-c C-q") 'mst-unplanner)
(define-key planner-mode-map (kbd "C-c C-x") 'mst-planner-task-done)
(define-key planner-mode-map (kbd "C-c C-C") 'planner-task-cancelled)

;; Allow links to emacs-wiki pages.
(defun planner-ewiki-annotation ()
  (when (eq major-mode 'emacs-wiki-mode)
    (format "[[ewiki://%s#%s][%s]]"
            emacs-wiki-current-project (emacs-wiki-page-name)
            (emacs-wiki-page-title))))

(defun planner-ewiki-browse-url (url)
  (when (string-match "\\`ewiki://\\(.+\\)#\\(.+\\)" url)
    (let ((project (match-string 1 url))
          (page (match-string 2 url)))
      (let ((emacs-wiki-current-project project))
        (find-file (emacs-wiki-page-file page))))))

(add-hook 'planner-annotation-functions 'planner-ewiki-annotation)
(planner-add-protocol "ewiki://" 'planner-ewiki-browse-url nil)


;; Create tasks from IRC, saving an extract from the buffer as reference.
(defun planner-irclog-annotation ()
  (when (eq major-mode 'erc-mode)
    (let* ((min (save-excursion
                  (beginning-of-line)
                  (forward-line -40)
                  (point)))
           (max (save-excursion
                  (beginning-of-line)
                  (forward-line 10)
                  (point)))
           (text (buffer-substring-no-properties min max)))
      (let ((page (loop for i from 0 do
                        (let ((page (concat "irc" (number-to-string i))))
                          (unless (planner-page-exists-p page)
                            (return page))))))
        (with-current-buffer (planner-goto-plan-page page)
          (let ((inhibit-read-only t))
            (erase-buffer)
            (insert "<literal>\n")
            (insert text)
            (insert "\n</literal>\n")
            (delete-matching-lines erc-prompt (point-min) (point-max))
            (delete-matching-lines "^$" (point-min) (point-max)))
          (save-buffer)
          (kill-buffer nil))
        (format "irclog://%s" page)))))

(defun planner-irclog-browse-url (url)
  (when (string-match "\\`irclog://\\(.+\\)$" url)
    (let ((page (match-string 1 url)))
      (planner-goto-plan-page page))))

(add-hook 'planner-annotation-functions 'planner-irclog-annotation)
(planner-add-protocol "irclog://" 'planner-irclog-browse-url nil)


(defun mst-planner-unhighlight-dates (beg end)
  (dolist (o (overlays-in beg end))
    (when (eq (overlay-get o 'type)
              'mst-planner-date)
      (delete-overlay o))))

(defun mst-planner-parse-date (date-string)
  (multiple-value-bind (year month day)
      (mapcar 'string-to-number (split-string date-string "-"))
    (time-to-seconds (encode-time 1 1 1 day month year))))


(defun mst-planner-highlight-dates (beg end)
  (let ((beg (point-min))
        (end (point-max)))
    (save-excursion
      (mst-planner-unhighlight-dates beg end)
      (goto-char beg)

      ;; Mark all dates with overlays
      (while (search-forward-regexp "(\\([0-9]*-[0-9]*-[0-9]*\\))" nil t)
        (let* ((date-string (match-string 1))
               (o (make-overlay (match-beginning 1) (match-end 1))))
          (overlay-put o 'type 'mst-planner-date)
          (overlay-put o 'date (mst-planner-parse-date date-string))))

      ;; Set the overlay faces
      (let ((dates (sort (remove-if-not (lambda (o)
                                          (eq (overlay-get o 'type)
                                              'mst-planner-date))
                                        (overlays-in beg end))
                         (lambda (o1 o2)
                           (> (overlay-get o1 'date)
                              (overlay-get o2 'date))))))
        (when dates
          (let* ((youngest (overlay-get (car dates) 'date))
                 (oldest (overlay-get (car (last dates)) 'date))
                 (mapper (mst-planner-make-mapper
                          oldest youngest
                          0 50)))
            (dolist (o dates)
              (let ((date (overlay-get o 'date)))
                (overlay-put o 'face
                             `(:foreground
                               ,(format "gray%d"
                                        (- 100
                                           (funcall mapper date)))))))))))))


(defun mst-planner-make-mapper (old-range-lower
                                old-range-upper
                                new-range-lower
                                new-range-upper)
  "Return a function that converts integers in the range
`old-range-lower'...`old-range-upper' to the range
`new-range-lower`...`new-range-upper'"
  `(lambda (n)
     (if (= ,old-range-lower ,old-range-upper)
         ,new-range-lower
       (+ (* (/ (- n ,old-range-lower)
                (float (- ,old-range-upper
                          ,old-range-lower)))
             (- ,new-range-upper ,new-range-lower))
          ,new-range-lower))))

;; Register the new-fangled highlighting
(add-hook 'planner-mode-hook
          (lambda ()
            (mst-planner-highlight-dates (point-min) (point-max))
            (jit-lock-register 'mst-planner-highlight-dates)))

(defun mst-planner-sort-tasks ()
  "Sort by priority and move 'in progress' tasks up"
  (skip-chars-forward "#ABC")
  (let ((case-fold-search t)
        (ch (char-before))
        status)
    (skip-chars-forward "0123456789 ")
    (setq status (char-after))
    (+
     (cond ((or (= status ?X)
                (= status ?C)) 0)
           ((= ch ?A) 10000)
           ((= ch ?B) 20000)
           ((= ch ?C) 30000)
           (t 0)))))

(setq planner-sort-tasks-key-function 'mst-planner-sort-tasks)

(provide 'mst-planner)
;;; mst-planner.el ends here