;;;
;;; Wanderlust -- Yet Another Message Interface on Emacsen.
;;;
;;; Copyright (C) 1999,2000,2001 Kenichi OKADA <okada@opaopa.org>
;;;
;;; Time-stamp: <2001-08-20 15:38:20 okada>
;;;
;;; 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.
;;;

(require 'elmo-nntp)
(require 'elmo-util)

(defvar wl-newsrc-file nil)
(defvar wl-newsrc-folder-regexp "^-")

(defun wl-newsrc-save ()
  (interactive)
  (if (and wl-summary-buffer-elmo-folder
	   (string-match
	    wl-newsrc-folder-regexp
	    (elmo-folder-name-internal
	     wl-summary-buffer-elmo-folder)))
      (wl-newsrc-make
       (list wl-summary-buffer-elmo-folder))))

(defun wl-newsrc-generate ()
  ;; Generate and save the .newsrc file.
  (interactive)
  (let ((folders
	 (mapcar '(lambda (folder)
		    (wl-folder-get-elmo-folder folder))
		 (delete nil
			 (mapcar '(lambda (folder)
				    (if (and (symbolp folder)
					     (string-match
					      wl-newsrc-folder-regexp
					      (symbol-name folder)))
					(symbol-name folder)))
				 wl-folder-entity-hashtb)))))
    (wl-newsrc-make folders)))

(defun wl-newsrc-make (folders)
  (save-excursion
    (let* ((tmp-buffer (get-buffer-create " *wl-newsrc*"))
	   (standard-output tmp-buffer)
	   (newsrc-filename
	    (or wl-newsrc-file
		(concat
		 (user-home-directory) "/.newsrc-"
		 (elmo-net-folder-server-internal
		  (car folders)))))
	   insert-file-contents-pre-hook
	   insert-file-contents-post-hook
	   folder)
      (set-buffer tmp-buffer)
      (erase-buffer)
      (if (and (file-exists-p newsrc-filename)
	       (file-readable-p newsrc-filename))
	  (insert-file-contents newsrc-filename))
      (setq buffer-file-name newsrc-filename)
      (buffer-disable-undo)
      (while (setq folder (pop folders))
	(condition-case nil
	    (wl-newsrc-make-internal folder)
	  (error nil nil)))
      (make-local-variable 'version-control)
      (setq version-control 'never)
      (if (file-writable-p newsrc-filename)
	  (save-buffer)
	(message (format "%s is not writable." newsrc-filename)))
      (kill-buffer (current-buffer)))))

(defun wl-newsrc-make-internal (folder)
  (save-excursion
    (let* ((unread-list
	    (sort (elmo-folder-list-unreads
		   folder
		   (list wl-summary-unread-cached-mark
			 wl-summary-unread-uncached-mark
			 wl-summary-new-mark))
		  '>))
	   (tmp-cons
	    (wl-newsrc-get-folder-info folder))
	   (min-number (string-to-int (car tmp-cons)))
	   (max-number (string-to-int (cdr tmp-cons)))
	   (folder-name
	    (substring
	     (elmo-folder-name-internal
	      folder) 1))
	   (continue nil)
	   unnum)

      (goto-char (point-min))
      (if (re-search-forward (concat "^" (regexp-quote folder-name)
				     "[!:]") nil t)
	  (progn
	    (beginning-of-line)
	    (kill-line))
	(goto-char (point-max))
	(if (null (eq (point)
		      (save-excursion
			(beginning-of-line)
			(point))))
	    (newline)))
      (insert folder-name)
      (insert ": \n")
      (goto-char (1- (point)))

      (while (and
	      (null continue)
	      (setq unnum (car unread-list)))
	(if (eq min-number unnum)
	    (progn
	      (setq min-number (+ 1 min-number))
	      (if (> min-number max-number)
		  (setq continue `end)
		(setq unread-list (cdr unread-list))))
	  (setq continue t)))

      (if (eq continue 'end)
	  nil
	(while (setq unnum (car unread-list))
	  (cond (
		 (> unnum (+ 1 min-number))
		 (insert (format (concat
				  "%d-%d,")
				 min-number (- unnum 1))))
	  ((eq unnum (+ 1 min-number))
	   (insert (format "%d,"
			   (- unnum 1)))))
	  (setq min-number (+ 1 unnum))
	  (setq unread-list (cdr unread-list)))

	(cond
	 ((> max-number min-number)
	  (insert (format (concat
			   "%d-%d")
			  min-number max-number)))
	 ((eq max-number min-number)
	  (insert (format "%d" max-number)))
	 (t (delete-backward-char 1)))))))

(defun wl-newsrc-get-folder-info (folder)
  (let* ((session
	  (elmo-nntp-get-session folder))
	 response)
    (save-excursion
      (elmo-nntp-send-command session
			      (format "group %s"
				      (substring
				       (elmo-folder-name-internal
					folder) 1)))
	(if (null (setq response (elmo-nntp-read-response session)))
	    (error "Select folder failed."))
	(if (string-match "211 \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) [^.].+$"
			  response)
	    (cons
	     (elmo-match-string 2 response)
	     (elmo-match-string 3 response))
	  nil))))

(provide 'wl-newsrc)