;;;; sidebrain-browse.el -- browser for sidebrain.el
;;; Time-stamp: <2005-12-02 14:59:13 john>

;;  This program 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 of the License, or (at your
;;  option) any later version.

;;  This program 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 this program; if not, write to the Free Software Foundation, Inc.,
;;  59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

(provide 'sidebrain-browse)
(require 'sidebrain)

;;;; browse tasks (and major mode thereunto)

(defvar sidebrain-browse-mode-hook nil
  "Functions to run on entering sidebrain-browse-mode.")

(defvar sidebrain-browse-tasks-mode-keymap (make-sparse-keymap "Browse tasks")
  "Major mode for browsing tasks.")

(suppress-keymap sidebrain-browse-tasks-mode-keymap)

(defun sidebrain-browse-tasks-move-to-label ()
  "Move to the label of the current task, and return it."
  (let* ((pattern "^    \\([^ ].+\\)$")
	 (whole-line (if (or (looking-at pattern)
			     (re-search-backward pattern (point-min) t))
			 (match-string-no-properties 1)
		       nil)))
    (if (string-match "\\(.+\\)\\( ([^()]+)\\)" whole-line)
	(match-string 1 whole-line)
      whole-line)))

(defun sidebrain-browse-tasks-get-project-group ()
  "Find the project group that the current task is part of."
  (save-excursion
    (if (re-search-backward "^Project group \"\\([^ ].+\\)\":" (point-min) t)
	(match-string-no-properties 1)
      nil)))

(defun sidebrain-browse-tasks-get-project ()
  "Find the project that the current task is part of."
  (save-excursion
    (if (re-search-backward "^  Project \"\\([^ ].+\\)\":" (point-min) t)
	(match-string-no-properties 1)
      nil)))

(defun sidebrain-browse-tasks-select ()
  "Resume the selected task."
  (interactive)
  (let ((label (sidebrain-browse-tasks-move-to-label))
	(group (sidebrain-browse-tasks-get-project-group))
	(project (sidebrain-browse-tasks-get-project)))
    (message "Selecting %S in %S:%S" label group project)
    (when (and label group project)
      (bury-buffer)
      (sidebrain-resume-task label t group project))))

(defun sidebrain-browse-tasks-next ()
  "Select the next task."
  (interactive)
  (let ((next (save-excursion
		(end-of-line 1)
		(re-search-forward "^    [^ ]" (point-max) t))))
    (if next
	(progn
	  (goto-char next)
	  (beginning-of-line 1)
	  (message "In project %s:%s" (sidebrain-browse-tasks-get-project-group) (sidebrain-browse-tasks-get-project)))
      (message "No further tasks"))))

(defun sidebrain-browse-tasks-previous ()
  "Select the previous task."
  (interactive)
  (let ((previous (save-excursion
		    (beginning-of-line 0)
		    (re-search-backward "^    [^ ]" (point-min) t))))
    (if previous
	(progn
	  (goto-char previous)
	  (beginning-of-line 1)
	  (message "In project %s:%s" (sidebrain-browse-tasks-get-project-group) (sidebrain-browse-tasks-get-project)))
      (message "No previous tasks"))))


(defun sidebrain-browse-tasks-next-project ()
  "Select the next project."
  (interactive)
  (if (re-search-forward "^  Project \"" (point-max) t)
      (sidebrain-browse-tasks-next)
    (message "No further projects")))

(defun sidebrain-browse-tasks-previous-project ()
  "Select the previous project."
  (interactive)
  (if (re-search-backward "^  Project \"" (point-min) t)
      (sidebrain-browse-tasks-next)
    (message "No previous projects")))

(defun sidebrain-browse-tasks-delete ()
  "Delete the current task."
  (interactive)
  (let ((label (sidebrain-browse-tasks-move-to-label))
	(group (sidebrain-browse-tasks-get-project-group))
	(project (sidebrain-browse-tasks-get-project)))
    ;; (message "got %S" label)
    (when label
      (let ((where (point)))
	(sidebrain-set-project-group group)
	(sidebrain-set-project project)
	(sidebrain-remove-tasks-labelled label)
	(sidebrain-browse-tasks)
	(when (<= where (point-max))
	  (goto-char where))))))

(defvar sidebrain-browse-tasks-marked nil
  "The currently marked tasks.")

(defun sidebrain-browse-tasks-marked ()
  "Return the list of marked tasks."
  (nreverse
   (mapcar (lambda (label)
	     (assoc label sidebrain-queue))
	   sidebrain-browse-tasks-marked)))

(defun sidebrain-browse-tasks-mark ()
  "Mark the selected task."
  (interactive)
  (save-excursion
    (let* ((label (sidebrain-browse-tasks-move-to-label))
	   (here (match-beginning 0)))
      (when label
	(pushnew label sidebrain-browse-tasks-marked :test 'string=)
	(re-search-forward "^$" (point-max) t)
	(put-text-property here (point) 'face (cons 'background-color "yellow")))))
  (message (substitute-command-keys
    "\\<sidebrain-browse-tasks-mode-keymap>\\[sidebrain-browse-tasks-unmark] to unmark, \\[sidebrain-mail-tasks] to mail marked tasks")))
  
(defun sidebrain-browse-tasks-unmark ()
  "Unmark the selected task."
  (interactive)
  (save-excursion
    (let ((label (sidebrain-browse-tasks-move-to-label))
	  (here (match-beginning 0)))
      (when label
	(setq sidebrain-browse-tasks-marked
	      (delete-if (lambda (task) (string= task label))
			 sidebrain-browse-tasks-marked))
	(re-search-forward "^$" (point-max) t)
	(put-text-property here (point) 'face (cons 'background-color nil))))))

(define-key sidebrain-browse-tasks-mode-keymap "
" 'sidebrain-browse-tasks-select)
(define-key sidebrain-browse-tasks-mode-keymap "n" 'sidebrain-browse-tasks-next)
(define-key sidebrain-browse-tasks-mode-keymap "p" 'sidebrain-browse-tasks-previous)
(define-key sidebrain-browse-tasks-mode-keymap "N" 'sidebrain-browse-tasks-next-project)
(define-key sidebrain-browse-tasks-mode-keymap "P" 'sidebrain-browse-tasks-previous-project)
(define-key sidebrain-browse-tasks-mode-keymap "q" 'bury-buffer)
(define-key sidebrain-browse-tasks-mode-keymap "d" 'sidebrain-browse-tasks-delete)
(define-key sidebrain-browse-tasks-mode-keymap "m" 'sidebrain-browse-tasks-mark)
(define-key sidebrain-browse-tasks-mode-keymap "u" 'sidebrain-browse-tasks-unmark)
(define-key sidebrain-browse-tasks-mode-keymap "M" 'sidebrain-mail-tasks)

;;;###autoload
(defun sidebrain-browse-tasks (&optional show-all)
  "Browse the task queue, and perhaps select a task.
With optional argument, display all groups and projects, even when empty."
  (interactive "P")
  (switch-to-buffer (get-buffer-create "*Browse tasks*"))
  (erase-buffer)
  (setq sidebrain-browse-tasks-marked nil)
  (dolist (project-group sidebrain-project-groups)
    (message "listing project group %S with cdr %S" (car project-group) (cdr project-group))
    (message "contents are %S" (mapcar 'cddr (cdr project-group)))
    (when (or show-all
	      (and (cdr project-group)
		   (reduce (lambda (a b) (or a b)) ; skip empty groups
			   (mapcar 'cddr (cdr project-group)))))
      (insert "Project group \""(car project-group) "\"")
      (when (eq project-group sidebrain-current-project-group)
	(insert " (current)"))
      (insert ":\n\n")
      (dolist (project (cdr project-group))
	(message "listing project %S with cdr %S" (car project) (cdr project))
	(when (or show-all (cdr project)) ; skip empty projects
	  (insert "  Project \"" (car project) "\"")
	  (when (eq project sidebrain-current-project)
	    (insert " (current)"))
	  (insert ":\n\n")
	  (dolist (task (cdr project))
	    (message "Adding task %S to browse display" task)
	    (let* ((task-label (first task)))
	      ;; (message "Using label %S" task-label)
	      (insert "    " task-label)
	      (let ((file (sidebrain-ok-file-name (get-text-property 0 'file task-label))))
		(when file
		  (insert " (" (file-name-nondirectory file) ")")))
	      (insert "\n")
	      (let ((subtasks (sidebrain-task-stack-tasks (cdr task))))
		(while subtasks
		  ;; don't put the last one in if it is the same as the label
		  (when (or show-all
			    (cdr subtasks)
			    (not (string= (car subtasks) task-label)))
		    (insert "      " (car subtasks) "\n"))
		  (setq subtasks (cdr subtasks))))
	      (when show-all
		(let ((observations (sidebrain-task-stack-observations (cdr task))))
		  (dolist (observation observations)
		    (insert "       :%s:\n" observations))))
	      (insert "\n"))))
	(insert "\n")))
    (insert "\n"))
  (goto-char (point-min))
  (sidebrain-browse-tasks-next)
  (sidebrain-browse-tasks-mode)
  (message
   (substitute-command-keys
    "\\<sidebrain-browse-tasks-mode-keymap>\\[sidebrain-browse-tasks-select] to select, \\[sidebrain-browse-tasks-mark] to mark, \\[bury-buffer] to quit")))

(defun sidebrain-browse-tasks-mode ()
  "Major mode for browsing the task queue.
Special commands available are:
\\{sidebrain-browse-tasks-mode-keymap}"
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'sidebrain-browse-tasks-mode
	mode-name "Browse tasks")
  (use-local-map sidebrain-browse-tasks-mode-keymap)
  (run-hooks 'sidebrain-browse-mode-hook))

;;;; mailing tasks

;;;###autoload
(defun sidebrain-mail-tasks (recipient)
  "Send selected tasks in the mail.
Should normally be used from sidebrain-browse-tasks-mode."
  (interactive "sMail tasks to: ")
  (unless (or (eq major-mode 'sidebrain-browse-tasks-mode)
	      (yes-or-no-p "Not in task browser; mail selected tasks anyway? "))
    (error "Not in tasks browser"))
  (compose-mail recipient "Tasks")
  (insert "<mailed_tasks>\n")
  (sidebrain-save-task-queue (sidebrain-browse-tasks-marked))
  (insert "</mailed_tasks>\n")
  (mail-subject))

;;;###autoload
(defun sidebrain-extract-tasks-from-mail ()
  "Parse the current buffer as a mail message, and pick up any tasks described in it."
  (interactive)
  (goto-char (point-min))
  (let (begin end)
    (if (and (setq end (search-forward "</mailed_tasks>" (point-max) t))
	     (setq begin (search-backward "<mailed_tasks>" (point-min) t)))
	(sidebrain-restore-queue (xml-parse-region begin end)))))

;;;; sidebrain menu setup

(defvar sidebrain-menu (make-sparse-keymap "Sidebrain")
  "Menu for main sidebrain operations.")

(fset 'sidebrain-menu sidebrain-menu)

(define-key sidebrain-menu [ sidebrain-read-comments ] '(menu-item "Read comments" sidebrain-read-todo-from-comments))
(define-key sidebrain-menu [ sidebrain-sep-c ] '(menu-item "--single-line"))
;; (define-key sidebrain-menu [ sidebrain-mail-tasks ] '(menu-item "Mail tasks" sidebrain-mail-tasks))
;; (define-key sidebrain-menu [ sidebrain-extract-tasks-from-mail ] '(menu-item "Extract tasks from mail" sidebrain-extract-tasks-from-mail))
(define-key sidebrain-menu [ sidebrain-resume-task ] '(menu-item "Resume task" sidebrain-resume-task))
(define-key sidebrain-menu [ sidebrain-suspend-task ] '(menu-item "Suspend task" sidebrain-suspend-task))
(define-key sidebrain-menu [ sidebrain-browse-tasks ] '(menu-item "Browse tasks" sidebrain-browse-tasks))
(define-key sidebrain-menu [ sidebrain-sep-b ] '(menu-item "--single-line"))
(define-key sidebrain-menu [ sidebrain-reminder ] '(menu-item "Reminder" sidebrain-reminder))
(define-key sidebrain-menu [ sidebrain-observe ] '(menu-item "Observation" sidebrain-observe))
(define-key sidebrain-menu [ sidebrain-sep-a ] '(menu-item "--single-line"))
(define-key sidebrain-menu [ sidebrain-end-task ] '(menu-item "End task" sidebrain-end-task))
(define-key sidebrain-menu [ sidebrain-begin-task ] '(menu-item "Begin task" sidebrain-begin-task))

;;; end of sidebrain-browse.el