;;; gnus-recover-ja.el --- recover Japasene messages from broken data
;; Copyright (C) 1998, 1999, 2000, 2001 Katsumi Yamaoka

;; Author: Katsumi Yamaoka <yamaoka@jpl.org>
;; Created: 1998-10-29
;; Revised: 2001-09-17
;; Keywords: mail, news, MIME

;; This file is not part of any packages.

;; 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 this program; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; This program will work with T-gnus 6.15.3 revision 05 and later and
;; T-gnus 6.15.4 revision 06 and later.

;; How to use
;;
;; 1. byte-compile this file and copy it to the apropriate directory.
;;
;; 2. put the following lines to your ~/.gnus file.
;;
;;(autoload 'gnus-summary-recover-article "gnus-recover-ja" nil t)
;;(eval-after-load "gnus-sum"
;;  '(define-key gnus-summary-mode-map
;;     "\C-x\C-r" 'gnus-summary-recover-article))

;;; Code:

(eval-when-compile (require 'cl))
(require 'mel)
(require 'mime-edit)
(require 'gnus-art)

(defvar gnus-recover-sjis-or-euc-jp-regexp
  (concat
   "\\("
   (mapconcat 'identity
	      '(; shift_jis
		"[\x81-\x84\x89-\xe9][\x40-\x7e\x80-\xfc]"
		"\x88[\x9f-\xfc]"
		"\xea[\x40-\x7e\x80-\xa2]"
		; euc-japan
		"[\xa1-\xa8][\xa1-\xfe]"
		"[\xb0-\xf3][\xa1-\xfe]"
		"\xf4[\xa1-\xa4]")
	      "\\|")
   "\\)+"))

(defvar gnus-recover-ja-load-hook nil)

(defun gnus-summary-recover-article (expected-coding-system)
  "Recover Japasene messages from broken data."
  ;; This command must be invoked from `gnus-summary-buffer'.
  (interactive
   (list
    (save-excursion
      (set-buffer gnus-original-article-buffer)
      (let ((config (current-window-configuration))
	    region cs exp)
	(unwind-protect
	    (progn
	      (goto-char (point-min))
	      (when (re-search-forward
		     gnus-recover-sjis-or-euc-jp-regexp nil t)
		(setq region (list (match-beginning 0) (match-end 0))
		      cs (apply 'detect-coding-region region))
		(apply 'put-text-property (append region '(face modeline)))
		(when (listp cs)
		  (setq cs (car cs)))
		(when (featurep 'xemacs)
		  (setq cs (coding-system-name cs)))
		(display-buffer (current-buffer))
		(setq exp
		      (read-coding-system
		       (format "Expected coding system (default %s): " cs)))
		(apply 'put-text-property (append region '(face nil)))
		(when (or (string-equal "" (prin1-to-string exp))
			  (not exp))
		  (setq exp cs))))
	  (set-window-configuration config))
	exp))))
  (if expected-coding-system
      (let (header)
	(save-excursion
	  (set-buffer gnus-original-article-buffer)
	  (save-restriction
	    (article-narrow-to-head)
	    (while (re-search-forward "^[^\t\n\r :]+" nil t)
	      (unless (eq ?: (char-after))
		(delete-region (match-beginning 0) (1+ (std11-field-end)))))
	    (unless (message-fetch-field "from")
	      (goto-char (point-max))
	      (insert "From: nobody\n"))
	    (unless (message-fetch-field "subject")
	      (goto-char (point-max))
	      (insert "Subject: (none)\n")))
	  (insert (prog1
		      (encode-coding-string
		       (decode-coding-string (buffer-string)
					     expected-coding-system)
		       'iso-2022-jp)
		    (erase-buffer)
		    (set-buffer-multibyte t)))
	  (mime-edit-again)
	  (mime-edit-exit)
	  (message "")
	  (set-buffer-multibyte nil)
	  (goto-char (point-min))
	  (re-search-forward
	   (format "^%s$" (regexp-quote mail-header-separator)))
	  (replace-match "")
	  (setq header (gnus-article-make-full-mail-header)
		gnus-current-headers header)
	  (set-buffer gnus-article-buffer)
	  (let ((inhibit-read-only t))
	    (erase-buffer))
	  (gnus-article-prepare-display)
	  (set-buffer gnus-summary-buffer)
	  (gnus-summary-update-article-line
	   (cdr gnus-article-current) header)))
    (message "Nothing to be done")))

(provide 'gnus-recover-ja)

(run-hooks 'gnus-recover-ja-load-hook)

;;; gnus-recover-ja.el ends here