;; -*- Emacs-Lisp -*-
;;; planner-browser.el -- 
;;; Author : Quasihiko Tsuruse <quasi@kc4.so-net.ne.jp> 
;;; http://www003.upp.so-net.ne.jp/quasi/
;;; Created: 2001/10/13 
;;; $Id: planner-browser.el,v 1.52 2002/11/13 14:46:32 tsuruse Exp $

;;; Note:
;;; This package works with planner.el by John Wiegley <johnw@gnu.org>.
;;; planner.el can publish html files and its indexes. 
;;; I just want to view many planner daily task list files 
;;; at the same time with indexes.

;;; Usage:
;;; M-x planner-browser-directory to show planner-directory.
;;; n, p next/previous-line 
;;; P Publish
;;; w Browse published file.
;;;

;;; ChangeLog 
(require 'emacs-wiki)
(require 'planner)
(require 'calendar)
(require 'diary-lib)

(defvar planner-browser-index-buffer " *planner index*" "Temporally")
(defvar planner-browser-index-window nil)
(defvar planner-browser-browsing-window nil)
(defvar planner-browser-calendar-window nil)
(defvar planner-browser-calendar-flag t
  "If non-nil, show calendar." )
(defvar planner-browser-move-and-show nil
  "If non-nil, show current line file after `planner-browser-next-line'.")

(defvar planner-browser-mode-map nil "Keymap for planner-browser.")

(if planner-browser-mode-map ()
  (setq planner-browser-mode-map (make-keymap))
  (suppress-keymap planner-browser-mode-map)
  (define-key planner-browser-mode-map "?" 'describe-mode)
  (define-key planner-browser-mode-map "h" 'describe-mode)
  (define-key planner-browser-mode-map "n" 'planner-browser-next-line)
  (define-key planner-browser-mode-map "p" 'planner-browser-previous-line)
  (define-key planner-browser-mode-map "q" 'planner-browser-exit)
  (define-key planner-browser-mode-map "o" 'planner-browser-show-other-window)
  (define-key planner-browser-mode-map "w" 'planner-browser-w3m-browse)
;;  (define-key planner-browser-mode-map "." 'planner-browser-goto-today)
  (define-key planner-browser-mode-map "\r" 'planner-browser-show-current-line)
  (define-key planner-browser-mode-map "\t" 'planner-browser-next-line)
  (define-key planner-browser-mode-map "P" 'planner-browser-publish-this-line)
  (define-key planner-browser-mode-map "t" 'planner-browser-insert-indexes-2)
  (define-key planner-browser-mode-map "T" 'planner-browser-insert-indexes-2-rotate-sort)
  (define-key planner-browser-mode-map "s" 'planner-browser-project-info)
  (define-key planner-browser-mode-map "v" 'emacs-wiki-change-project)
  (define-key planner-browser-mode-map "c" 'planner-browser-calendar-toggle)
  (define-key planner-browser-mode-map [mouse-2] 'planner-browser-mouse-show)
  )

(defun planner-browser-w3m-browse (&optional afile)
  "Browse published planner file by w3m.
If AFILE is nil, use `planner-browser-get-file-name'.
"
  (interactive)
  (require 'w3m)
  (let ((sw (selected-window))
		(url (emacs-wiki-published-file 
			  (or afile (planner-browser-get-file-name)))))
	(planner-browser-publish-this-line)
	(save-excursion
	  (select-window (next-window))
	  (w3m-find-file url))
	(select-window sw)))

(defun planner-browser-publish-this-line ()
  "Force publication of the current line planner."
  (interactive)
  (emacs-wiki-publish-files (list (planner-browser-get-file-name)) nil))

(defun planner-browser-exit ()
  "Exit planner-browser-mode."
  (interactive)
  (if (> (length (window-list)) 1)
	  (delete-window planner-browser-index-window))
  (kill-buffer planner-browser-index-buffer)
  (if (window-live-p planner-browser-calendar-window)
      (delete-window planner-browser-calendar-window))
  (message ""))

(defun planner-browser-init-window ()
  "Split window to browse."
  (interactive)
  (setq planner-browser-browsing-window (selected-window))
  (setq planner-browser-index-window 
		(split-window planner-browser-browsing-window 
					  (round (* (nth 2 (window-edges)) 0.7)) t))
  (if planner-browser-calendar-flag 
	  (progn 
		(planner-browser-calendar)
		(planner-browser-calendar-split)))
  (set-window-buffer planner-browser-index-window planner-browser-index-buffer))

(defun planner-browser-calendar-split ()
  "Split window to show calendar."
  (setq planner-browser-calendar-window 
		(split-window planner-browser-browsing-window 
					  (round (* (nth 3 (window-edges)) 0.7))))
  (set-window-buffer planner-browser-calendar-window calendar-buffer)
  (fit-window-to-buffer planner-browser-calendar-window))

(defun planner-browser-calendar-toggle ()
  (interactive)
  "Show/Hide Calendar."
  (if (window-live-p planner-browser-calendar-window)
	  (delete-window planner-browser-calendar-window)
	(planner-browser-calendar-split)))

(defun planner-browser-calendar (&optional arg)
  "Copy of `calendar-basic-setup'.
But use just `set-buffer' instead of `pop-to-buffer' to control buffer."
  (interactive "P")
  (set-buffer (get-buffer-create calendar-buffer))
  (calendar-mode)
  (let* ((split-height-threshold 1000)
         (date (if arg
                   (calendar-read-date t)
                 (calendar-current-date)))
         (month (extract-calendar-month date))
         (year (extract-calendar-year date)))
    (set-buffer calendar-buffer)
    (increment-calendar-month month year (- calendar-offset))
    (generate-calendar-window month year)
    (if (and view-diary-entries-initially (calendar-date-is-visible-p date))
        (view-diary-entries
         (if (vectorp number-of-diary-entries)
             (aref number-of-diary-entries (calendar-day-of-week date))
           number-of-diary-entries))))
  (let* ((diary-buffer (get-file-buffer diary-file))
         (diary-window (if diary-buffer (get-buffer-window diary-buffer)))
         (split-height-threshold (if diary-window 2 1000)))
    (if view-calendar-holidays-initially
        (list-calendar-holidays)))
  (run-hooks 'initial-calendar-window-hook))

(defun planner-browser-mark-planning-entries ()
  "Mark calendar if daily planning file exists."
  (interactive)
  (setq mark-diary-entries-in-calendar t) ;;?
  (let ((alist (planner-browser-file-alist '(planner-browser-file-daily-p)))
		(afile))
	(while alist
	  (setq afile (planner-browser-decorate-wiki-file 
				   (planner-browser-get-file-name-from-file-alist alist)))
	  (mark-calendar-date-pattern (planner-browser-match-daily afile 2)
								  (planner-browser-match-daily afile 3)
								  (planner-browser-match-daily afile 1))
	  (setq alist (cdr alist)))))

(defun planner-browser-match-daily (afile group)
  "Return integer. group 1:yyyy, 2:mm, 3:dd."
  (string-to-int (substring afile (match-beginning group) (match-end group))))

(defun planner-browser-next-line (arg)
  "Go next-line with ARG."
  (interactive "p")
  (forward-line arg)
  (if planner-browser-move-and-show
	  (planner-browser-show-current-line)))
  
(defun planner-browser-previous-line (arg)
  "Go previous-line with ARG."
  (interactive "p")
  (planner-browser-next-line (- arg)))

(defun planner-browser-show-current-line ()
  "Show current line contents."
  (interactive)
  (planner-browser-show (planner-browser-get-file-name)))

(defun planner-browser-show (afile &optional ifnotexist)
  "Show AFILE (wiki file) at current line to other window.
If AFILE is not exist, call IFNOTEXIST.
"
  (let ((sw (selected-window))
		(contentbuf))
	(cond 
	 ((file-directory-p afile)
	  (message "file-directory-p. "))
	 ((file-readable-p afile)
	  (setq contentbuf (find-file-noselect afile))
	  (set-window-buffer planner-browser-browsing-window contentbuf))
	 (t (if (functionp ifnotexist)
			(funcall ifnotexist afile))))
	(select-window sw)))

(defun planner-browser-show-other-window ()
  "Show wiki file at current line to other window and point the window."
  (interactive)
  (let ((afile (planner-browser-get-file-name)) 
		(contentbuf))
	(save-excursion 
	  (cond 
	   ((file-directory-p afile)
		(message "file-directory-p. "))
	   (t 
		(setq contentbuf (find-file-noselect afile))
		(pop-to-buffer contentbuf))))))

(defun planner-browser-mouse-show (event)
  "Show wiki file at current mouse position to other window."
  (interactive "e")
  (let ((afile))
	(save-excursion
	  (set-buffer (window-buffer (posn-window (event-end event))))
	  (save-excursion
		(goto-char (posn-point (event-end event)))
		(setq afile (planner-browser-get-file-name))))
	(select-window (posn-window (event-end event)))
	(planner-browser-show afile)))

(defun planner-browser-show-monthly-index ()
  "Show monthly index."
  (interactive)
  (let ((afile (concat (format-time-string "%Y") "." (format-time-string "%m")))
		(contentbuf))
	(save-excursion 
	  (setq contentbuf (find-file-noselect afile))
		(pop-to-buffer contentbuf))))

(defun planner-browser-insert-monthly-index()
  "Insert yyyy.mm.dd file-name(s) of this month"
  (interactive)
  (let (x)
	(progn
	  (setq x (planner-browser-monthly-index-alist))
	  (while x
		(insert (car (car x)) "\n")
		(setq x (cdr x))))))

(defun planner-browser-monthly-index-alist (&optional year month)
  "File alist of month."
  (interactive)
  (let ((filealist (emacs-wiki-file-alist nil))
		(result))
	(while filealist
	  (if (planner-browser-file-display-p 
		   '((lambda (x) (planner-browser-file-year-month-p x year month)))
		   (planner-browser-get-file-name-from-file-alist filealist))
		  (setq result (cons (car filealist) result)))
	  (setq filealist (cdr filealist)))
	(setq result (sort result 'planner-browser-sort-alist))))

(defun planner-browser-get-file-name-from-file-alist (alist)
  "Get filename from `emacs-wiki-file-alist'. ((filename fullfilename) ...)"
  (car (car alist)))

(defun planner-browser-get-directory ()
  "Return directory."
  planner-directory)

(defun planner-browser-get-file-name (&optional notexpand)
  "Get planner file-name in browsing buffer."
  (let ((afile))
	(save-excursion
	  (beginning-of-line)
	  (setq afile
			(buffer-substring
			 (point)
			 (progn (skip-chars-forward "^ \t\n") (point))))
	  (if notexpand afile
		  (setq afile 
				(expand-file-name afile (planner-browser-get-directory)))))))

(defun planner-browser-project-info ()
  "Show project-specific emacs-wiki variable settings."
  (interactive)
  ;;(describe-variable 'emacs-wiki-projects)
  (message 
   (concat "emacs-wiki-current-project:" 
		   (or emacs-wiki-current-project "nil") ", emacs-wiki-directories:" 
		   (mapconcat 'concat emacs-wiki-directories ","))))

(defalias 'planner-browser-rotate-content 'planner-browser-insert-indexes-2)

(defun planner-browser-insert-indexes-2 (&optional keeprule)
  "Show wiki file which matches with current rule.
if keeprule, just redraw without rotate rule."
  (interactive)
  (or keeprule (setq planner-browser-rule-idx (1+ planner-browser-rule-idx)))
  (message (planner-browser-get-rule-message))
  (planner-browser-insert-indexes 
   (planner-browser-file-alist (planner-browser-get-rule))))

(defun planner-browser-insert-indexes-2-rotate-sort ()
  "(re)Show wiki file which matches with current rule."
  (interactive)
  (setq planner-browser-sort-func-idx (1+ planner-browser-sort-func-idx))
  (planner-browser-insert-indexes-2 t))

(defun planner-browser-insert-indexes (alist)
  "Insert wiki file names.
ALIST is like `emacs-wiki-file-alist'. ((filename fullfilename) ...)
"
  (save-excursion
	(setq buffer-read-only nil)
	(erase-buffer)
	(while alist
	  (insert (planner-browser-decorate-wiki-file 
			   (planner-browser-get-file-name-from-file-alist alist)))
	  (setq alist (cdr alist))
	  (if alist (insert "\n")))
	(goto-char (point-min))
	(setq buffer-read-only t))
  (run-hooks 'planner-browser-insert-indexes-hook))

(setq planner-browser-sort-func-idx 0)

(defun planner-browser-get-sort ()
  "get sort func. "
  (nth planner-browser-sort-func-idx planner-browser-sort-func))

(setq planner-browser-sort-func
	  '(planner-browser-sort-alist planner-browser-sort-alist-reverse))

(setcdr 
 (nthcdr (- (length planner-browser-sort-func) 1)
			   planner-browser-sort-func) 
	   planner-browser-sort-func)

(defvar planner-browser-insert-indexes-hook 
  '(planner-browser-mark-planning-entries)
  "*List of functions called whenever 
`planner-browser-insert-indexes' is called.")

(defun planner-browser-decorate-wiki-file (afile)
  "Decorate special file name.
TODO: Add more text-properties.
"
  (let ((filename afile)
		(file-attributes (file-attributes afile))
		attr)
 	(setq afile
 		  (if (string= afile (planner-today))
 			  (concat afile " " "*")
 			afile))
;;	(set-text-properties 0 (length filename) 
;;	 '(mouse-face highlight help-echo "mouse-2:visit") filename)
	afile))

(defun planner-browser-file-alist (&optional rules)
  "Return file alist like `emacs-wiki-file-alist' 
therefore ((filename fullpath) ...).
If rules non-nil, call it with a file in turn, 
and add it to result only when the rule returns t.
"
  (let ((filealist (emacs-wiki-file-alist nil))
		(result))
	(if rules 
		(while filealist
		  (if (planner-browser-file-display-p 
			   rules 
			   (planner-browser-get-file-name-from-file-alist filealist))
			  (setq result (cons (car filealist) result)))
		  (setq filealist (cdr filealist)))
	  ;;no rule
	  (setq result filealist))
	(setq result (sort result (planner-browser-get-sort)))))

(defun planner-browser-file-display-p (rules afile)
  "Return afile when funcall rule returns t."
  (and rules
	   (if (funcall (car rules) afile)
		   afile
		 ;;recursion call
		 (planner-browser-file-display-p (cdr rules) afile))))

(defun planner-browser-file-daily-p (afile)
  "If afile is daily planning file, return non-nil."
  (string-match 
   "\\([0-9][0-9][0-9][0-9]\\)\\.\\([0-1][0-9]\\)\\.\\([0-3][0-9]\\)" afile))

(defun planner-browser-file-thismonth-p (afile)
  "If afile is daily planning file in this month, return non-nil."
  (planner-browser-file-year-month-p afile))

(defun planner-browser-file-year-month-p (afile &optional year month)
  "If afile is daily planning file in year month, return non-nil.
match only year.month.** file. don't match year.month file.
"
  (string-match 
   (concat (or year (format-time-string "%Y")) "\\." 
		   (if year
			   (if month
				   (concat month "\\.[0-3][0-9]")
				 "[0-1][0-9]\\.[0-3][0-9]")
			 (concat (format-time-string "%m") "\\.[0-9][0-9]")))
   afile))


(defun planner-browser-file-wiki-p (afile)
  (string-match "[A-Z]" afile))

(defun planner-browser-file-allways-p (afile) t)

(defun planner-browser-file-franklin-p (afile)
  "FranlinPlanner(TM) like file name. 
See http://www.franklincovey.co.jp/
"
  (string-match 
   "\\(GoalPlanning\\)\\|\\(MyValues\\)\\|\\(MissionStatement\\)\\|\\(KeyInformation\\)" 
				afile))

;; set rotation list.
;; don't eval length planner-browser-file-display-rule-ring, 
;; cause infinite-loop.
(defvar planner-browser-file-display-rule-ring nil
  "List of rules to display. ((MESSAGE . (RULE1 RULE2 ...)) ...)
(MESSAGE . (RULE1 RULE2 ...)) is a set of rules.
")

(defun planner-browser-make-ring (list)
  "make ring list.
don't eval length of ring."
  (if (listp list)
	  (setcdr (nthcdr (1- (length list)) list) list)
	nil))

;; (setq my-year-month '(1 2 3 4 5 6 7 8 9 10 11 12)) => (1 2 3 4 5 6 7 8 9 10 11 12)
;; (planner-browser-make-ring my-year-month) => (1 2 3 4 5 6 7 8 9 10 11 12 ...)
;; (nth 0 my-year-month) => 1
;; (nth 12 my-year-month) => 1
;; (nth 120 my-year-month) => 1
  
(or planner-browser-file-display-rule-ring
	;; default planner-browser-file-display-rule-ring.
	(progn 
	  (setq planner-browser-file-display-rule-ring
			'(
			  ("Franklin Planner files and thid month." . (planner-browser-file-franklin-p planner-browser-file-thismonth-p))
			  ("Wiki and daily files in this month." . 
			   (planner-browser-file-wiki-p planner-browser-file-thismonth-p))
			  ("All files." . (planner-browser-file-allways-p))
			  ("All Daily files." . (planner-browser-file-daily-p))
			  ;;		  ("Planner-browser." . ((lambda (x) (string-match "PlannerBrowser" x))))
			  ))
	  ;; get rotation list
	  (planner-browser-make-ring planner-browser-file-display-rule-ring)))


(defvar planner-browser-rule-idx 0
  "Index of planner-browser-rule")

(defun planner-browser-get-rule (&optional idx)
  "Get display file rule list."
  (cdr (nth (or idx planner-browser-rule-idx) 
			planner-browser-file-display-rule-ring)))

(defun planner-browser-get-rule-message (&optional idx)
  "Get display file rule message."
  (car (nth (or idx planner-browser-rule-idx) 
			planner-browser-file-display-rule-ring)))

(defun planner-browser-sort-alist (l r)
  "Function for sorting."
  (string-lessp (car l) (car r)))

(defun planner-browser-sort-alist-reverse (l r)
  "Function for sorting."
  (string-lessp (car r) (car l)))

(defun planner-browser-calendar-no-planner-entry (afile)
  "If AFILE (year.month.date) does not exist, show message."
  (message (format "%s does not exist." afile)))

(defun planner-browser-calendar-goto ()
  "Goto the planning file corresponding to the calendar date.
Correspond to `planner-calendar-goto'."
  (interactive)
  (let ((cdate (calendar-cursor-to-date))
		(afile))
	(setq afile 
		  (expand-file-name
		   (format "%04d.%02d.%02d" (nth 2 cdate) (nth 0 cdate) (nth 1 cdate))
		   (planner-browser-get-directory)))
	(planner-browser-show afile 'planner-browser-calendar-no-planner-entry)))

(add-hook 'calendar-move-hook 'planner-browser-calendar-goto)

(defvar planner-browser-mode-hook nil
  "*List of functions called whenever `planner-browser-directory' is called.")

(defun planner-browser-directory ()
  "Browse planner directory.
Special commands:
\\[planner-browser-next-line] move to next planner file.
\\[planner-browser-previous-line] move to previous planner file.
\\[planner-browser-exit] exit planner-browser.
\\[planner-browser-show-current-line] Show current Planner file.
\\[planner-browser-publish-this-line] Publish current Planner file.
\\[planner-browser-insert-indexes-2] Rotate content.
\\[planner-browser-calendar-toggle] Show/Hide Calendar.
\\[planner-browser-project-info] Show project info.

\\[describe-mode] Show this message.
"
  (interactive)
  (save-excursion
	(get-buffer-create planner-browser-index-buffer)
	(planner-browser-init-window)
	(set-buffer planner-browser-index-buffer)
	(setq truncate-lines t)
	(planner-browser-insert-indexes 
	 (planner-browser-file-alist (planner-browser-get-rule)))
	(select-window planner-browser-index-window)
	(setq major-mode 'planner-browser-directory mode-name 
		  "planner-browser-mode")
	(setq mode-line-buffer-identification `(,emacs-wiki-current-project))
	(setq mode-line-format
		  '(" " mode-line-buffer-identification ":"	))
	;;	  (emacs-wiki-use-font-lock);;?
	(use-local-map planner-browser-mode-map)
	(run-hooks 'planner-browser-mode-hook)))