;;; wl-news.el --- Create notification from NEWS(.ja) for Wanderlust.

;; Copyright (C) 2002 Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
;; Copyright (C) 2002 Kenichi OKADA <okada@opaopa.org>

;; Author: Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
;;	Kenichi OKADA <okada@opaopa.org>
;; Keywords: mail, net news

;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).

;; 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, 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 GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;

;;; Commentary:
;;

;;; Code:
;;

(require 'elmo)
(require 'wl-vars)
(require 'wl-util)
(require 'wl-address)
(require 'wl-folder)

(defvar wl-news-version-file-name "previous-version")
(defvar wl-news-default-previous-version '(2 0 0))

(defvar wl-news-lang
  (if (and (boundp 'current-language-environment)
	   (string-equal "Japanese"
			 (symbol-value 'current-language-environment)))
      '("ja" "en") '("en" "ja"))
	"The list of languages to show NEWS. (order sensitive)")

(defun wl-news-check ()
  (let* ((updated (not (wl-news-already-current-p))))
    (if updated
	(if (and wl-news-lang
		 (wl-news-check-news
		  (cdr (wl-news-previous-version-load))
		  wl-news-lang)
		 (not (memq 'wl-news wl-hook)))
	    (add-hook 'wl-hook 'wl-news))
      ;; update wl-news-version-file
      (wl-news-previous-version-save
       (product-version (product-find 'wl-version))
       (cdr (wl-news-previous-version-load))))
    updated))

;;; -*- news-list -*-


;;; -*- news-list-end -*-

(defun wl-news-previous-version-load ()
  (with-temp-buffer
    (let ((filename (expand-file-name
		     wl-news-version-file-name
		     elmo-msgdb-directory))
	  insert-file-contents-pre-hook
	  insert-file-contents-post-hook
	  ret-val)
      (if (not (file-readable-p filename))
	  (cons wl-news-default-previous-version
		wl-news-default-previous-version)
	(insert-file-contents filename)
	(condition-case nil
	    (read (current-buffer))
	  (error nil nil))))))

(defun wl-news-previous-version-save (current-version previous-version)
  (with-temp-buffer
    (let ((filename (expand-file-name
		     wl-news-version-file-name
		     elmo-msgdb-directory))
	  print-length print-level)
      (prin1 (cons current-version previous-version) (current-buffer))
      (princ "\n" (current-buffer))
      (if (file-writable-p filename)
	  (write-region (point-min) (point-max)
			filename nil 'no-msg)
	(message "%s is not writable." filename)))))

(defun wl-news-append-news (lang previous-version &optional no-mime-tag)
  (require 'wl-mime)
  (let ((news-list (cdr (assoc lang wl-news-news-alist)))
	ret)
    (when news-list
      (if no-mime-tag
	  (insert "--------------\n")
	(mime-edit-insert-tag "text" "plain" "" ""))
      (while (< 0
		(product-version-compare
		 (car (car news-list))
		 previous-version))
	(setq ret t)
	(insert (cdr (car news-list)) "\n\n")
	(setq news-list (cdr news-list))))
    ret))

(defun wl-news-check-news (version news-lang)
  (let ((lang news-lang)
	news-list ret)
    (while (car lang)
      (setq news-list (cdr (assoc (car lang) wl-news-news-alist)))
      (while (< 0
		(product-version-compare
		 (car (car news-list)) version))
	(setq ret t)
	(setq news-list (cdr news-list)))
      (setq lang (cdr lang)))
    ret))

(defun wl-news-already-current-p ()
  (>= 0 (product-version-compare
	 (product-version (product-find 'wl-version))
	 (car (wl-news-previous-version-load)))))

(defun wl-news-send-news (version news-lang folder)
  (require 'wl-draft)
  (let ((lang (if (listp wl-news-lang)
		  wl-news-lang
		(list wl-news-lang)))
	send-buffer
	wl-fcc wl-bcc ret)
    (save-window-excursion
      (set-buffer
       (setq send-buffer (wl-draft-create-buffer)))
      (wl-draft-create-contents
       (list (cons 'From "WL Release 'Bot <wl@lists.airs.net>")
	     (cons 'To (wl-draft-eword-encode-address-list wl-from))
	     (cons 'Subject "Wanderlust NEWS")
	     (cons 'Date (wl-make-date-string))
	     (cons 'User-Agent wl-generate-mailer-string-function)))
      (wl-draft-insert-mail-header-separator)
      (wl-draft-prepare-edit)
      (goto-char (point-max))
      (insert "\nThis message is automatically generated by Wanderlust.\n\n")
      ;; insert news
      (while (car lang)
	(wl-news-append-news (car lang) version)
	(setq lang (cdr lang)))
      ;; encode
      (let ((mime-header-encode-method-alist
	     '((eword-encode-unstructured-field-body))))
	(mime-edit-translate-buffer))
      (wl-draft-get-header-delimiter t)
      (setq ret
	    (and (elmo-folder-writable-p
		  (wl-folder-get-elmo-folder folder))
		 (elmo-folder-append-buffer
		  (wl-folder-get-elmo-folder folder))))
      (wl-draft-hide send-buffer)
      (wl-draft-delete send-buffer))
    ret))

;;; wl-news-mode

(defvar wl-news-buf-name "NEWS")
(defvar wl-news-mode-map nil)
(defvar wl-news-winconf nil)
(defvar wl-news-buffer-oldest-version nil)
(make-variable-buffer-local 'wl-news-buffer-oldest-version)

(unless wl-news-mode-map
  (setq wl-news-mode-map (make-sparse-keymap))
  (define-key wl-news-mode-map "q"     'wl-news-exit)
  (define-key wl-news-mode-map "Q"     'wl-news-force-exit)
  (define-key wl-news-mode-map "\C-xk" 'wl-news-exit)
  (define-key wl-news-mode-map "a"     'wl-news-show-all)
  (define-key wl-news-mode-map "m"     'wl-news-append-to-folder)
  (define-key wl-news-mode-map "\C-m"  'wl-news-next-line)
  (define-key wl-news-mode-map " "     'wl-news-next-page)
  (define-key wl-news-mode-map "\177"  'wl-news-previous-page)
  ;; re-bind commands of outline-mode
  (define-key wl-news-mode-map "n"     'outline-next-visible-heading)
  (define-key wl-news-mode-map "p"     'outline-previous-visible-heading)
  (define-key wl-news-mode-map "u"     'outline-up-heading)
  (define-key wl-news-mode-map "N"     'outline-forward-same-level)
  (define-key wl-news-mode-map "P"     'outline-backward-same-level))

(require 'derived)
(define-derived-mode wl-news-mode outline-mode "NEWS"
  "Mode for Wanderlust NEWS(.ja)."
  (setq buffer-read-only t))

(defun wl-news (&optional arg)
  (interactive "P")
  (remove-hook 'wl-hook 'wl-news)
  (let* ((previous-version (if arg wl-news-default-previous-version
			     (cdr (wl-news-previous-version-load))))
	 (lang wl-news-lang)
	 window-lines lines)
    (if (or (get-buffer wl-news-buf-name)
	    (if (wl-news-check-news previous-version wl-news-lang)
		(progn
		  (setq wl-news-winconf (current-window-configuration))
		  (set-buffer (get-buffer-create wl-news-buf-name))
		  (wl-news-mode)
		  (setq wl-news-buffer-oldest-version previous-version)
		  (buffer-disable-undo (current-buffer))
		  ;; insert news
		  (let ((buffer-read-only nil))
		    (insert "--- Wanderlust NEWS ---  press 'a' to show all NEWS\n")
		    (insert "                         press 'm' to mail this NEWS to your folder\n")
		    (insert "                         press 'q' to quit\n")
		    (insert "                         press 'Q' to force quit\n\n")
		    (while (car lang)
		      (wl-news-append-news
		       (car lang) previous-version t)
		      (setq lang (cdr lang))))
		  t)
	      (message "No NEWS.")
	      nil))
	(progn
	  (switch-to-buffer wl-news-buf-name)
	  (delete-other-windows)
	  (goto-char (point-min))))))

(defun wl-news-next-line ()
  (interactive)
  (scroll-up 1))

(defun wl-news-next-page ()
  (interactive)
  (scroll-up))

(defun wl-news-previous-page ()
  (interactive)
  (scroll-down))

(defun wl-news-show-all ()
  (interactive)
  (when (eq major-mode 'wl-news-mode)
    (kill-buffer (current-buffer))
    (wl-news t)))

(defun wl-news-exit ()
  (interactive)
  (let* ((oldest-version (cdr (wl-news-previous-version-load)))
	 (current-version (product-version (product-find 'wl-version)))
	 (new-old-version current-version)
	 (buf (get-buffer wl-news-buf-name)))
    (when buf
      (if (wl-news-check-news oldest-version wl-news-lang)
	  (if (y-or-n-p "Do you want to see this message again? ")
	      (progn
		(message "Please M-x wl-news if you want to see it.")
		(setq new-old-version oldest-version))))
      (wl-news-previous-version-save
       current-version new-old-version)
      (kill-buffer (current-buffer))
      (if wl-news-winconf
	  (set-window-configuration wl-news-winconf))
      (kill-buffer buf)
      (if wl-news-winconf
	  (set-window-configuration wl-news-winconf)))))

(defun wl-news-append-to-folder ()
  (interactive)
  (let* ((current-version (product-version (product-find 'wl-version)))
	 (new-old-version current-version)
	 (folder wl-default-folder))
    (if (or (and (elmo-folder-writable-p
		  (wl-folder-get-elmo-folder folder))
		 (y-or-n-p (format
			    "Do you want to append this message to %s ? "
			    wl-default-folder)))
	    (setq folder
		  (wl-summary-read-folder wl-default-folder "to append ")))
	(or (wl-news-send-news wl-news-buffer-oldest-version wl-news-lang folder)
	    (error "Cannot append NEWS mail to %s" folder)))))

(defun wl-news-force-exit ()
  (interactive)
  (let ((buf))
    (when (setq buf (get-buffer wl-news-buf-name))
      (wl-news-previous-version-save
       (product-version (product-find 'wl-version))
       (cdr (wl-news-previous-version-load)))
      (kill-buffer buf)
      (if wl-news-winconf
	  (set-window-configuration wl-news-winconf)))))


(require 'product)
(product-provide (provide 'wl-news) (require 'wl-version))


;; Local Variables:
;; no-byte-compile: t
;; End:
;;; wl-news.el ends here