;; Additional utility for GNUS (automatic code conversion support)
;; Copyright (C) 1992 Free Software Foundation, Inc.
;; This file is part of Mule (MULtilingual Enhancement of GNU Emacs).

;; Mule is free software distributed in the form of patches to GNU Emacs.
;; 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 1, or (at your option)
;; any later version.

;; Mule 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, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; This package enables GNUS to code convert automatically
;;; accoding to a coding-system specified for each news group.
;;; Please put the following line in your .emacs:
;;;	(setq gnus-Group-mode-hook 'gnusutil-initialize)
;;;	(setq gnus-group-mode-hook 'gnusutil-initialize)
;;;	;(gnusutil-add-group "xxx.yyy.zzz" 'some-coding-system)

;;; 93.6.7   created for Mule Ver.0.9.8 by K.Handa <handa@etl.go.jp>
;;;	Modified from the original hz2gb.el for more generic use.
;;; 93.6.18  modified for Mule Ver.0.9.8 by K.Handa <handa@etl.go.jp>
;;;	Completely re-written for GNUS 3.14.4
;;; 93.7.12  modified for Mule Ver.0.9.8 by K.Handa <handa@etl.go.jp>
;;;	Add coding-system *fj* support.
;;; 93.7.13  modified for Mule Ver.0.9.8 by K.Sakai<ksakai@mtl.t.u-tokyo.ac.jp>
;;;	Modified for GNUS 3.15.
;;; 93.8.3   modified for Mule Ver.1.1 by K.Handa <handa@etl.go.jp>
;;;	Typo: gnusutil-Article-prepare-hook -> gnusutil-article-prepare-hook.
;;; 93.9.28  modified for Mule Ver.1.1 by K.Handa <handa@etl.go.jp>
;;;	fj-valid-esc-seq fixed.
;;; 93.11.18 modified for Mule Ver.1.1 by K.Handa <handa@etl.go.jp>
;;;	Coding-system for posting is set dynamically from Newsgroup:.
;;; 93.11.19 modified for Mule Ver.1.1 by Y.Kawabe <kawabe@sra.co.jp>
;;;	Type in gnusutil-toggle-article-format fixed.
;;; 93.12.11 modified for Mule Ver.1.1
;;;				by Y.Kanazawa <kanazawa@flab.fujitsu.co.jp>
;;;	gnusutil-add-hook should have append option for several hooks.
;;; 94.6.17  modified for Mule Ver.2.0 by K.Handa <handa@etl.go.jp>
;;;	Should not convert CRLF to LF.
;;; 94.6.21  modified for Mule Ver.2.0 by K.Handa <handa@etl.go.jp>
;;;	In some case, gnus-current-article is nil.
;;; 94.6.28  modified for Mule Ver.2.0 by K.Handa <handa@etl.go.jp>
;;;	gnusutil-add-hook -> add-hook (of Emacs19).

(require 'gnus)

(defconst gnusutil-version "1.8")

(if (and (boundp 'gnus-version)
	 (let ((case-fold-search nil))
	   (string-match "\\`Gnus 5" gnus-version)))
    (error "gnusutil %s doesn't work with %s" gnusutil-version gnus-version))

(defvar gnusutil-news-groups nil
  "Assoc list of news groups in which special encoding is used.
Each element is a list of news-group name (regular expression)
and cons of coding-systems for read and write.")

;;;###autoload
(defun gnusutil-add-group (name coding-system)
  "Specify that news group NAME is encoded in CODING-SYSTEM.
Subject and article buffers are automatically converted appropriately.
If CODING-SYSTEM is cons, the car/cdr part is regarded as coding-system
for read/write respectively."
  (if (not (consp coding-system))
      (setq coding-system (cons coding-system coding-system)))
  (setq name (concat "^" (regexp-quote name)))
  (let ((group (assoc name gnusutil-news-groups)))
    (if group
	(rplacd group coding-system)
      (setq gnusutil-news-groups
	    (cons (cons name coding-system) gnusutil-news-groups)))))

(defun gnusutil-get-coding-system (name)
  "Return the coding-system for news group NAME."
  (let ((groups gnusutil-news-groups)
	(len -1)
	coding-system)
    (while groups
      (if (and (string-match (car (car groups)) name)
	       (= (match-beginning 0) 0) ;93.11.18 by K.Handa
	       (> (match-end 0) len))
	  (setq len (match-end 0)
		coding-system (cdr (car groups))))
      (setq groups (cdr groups)))
    coding-system))

(defvar gnusutil-summary-encoded nil
  "A flag to indicate if subject buffer is encoded or not. (obsolete)")
(defvar gnusutil-article-encoded nil
  "A flag to indicate if article buffer is encoded or not.")
(defvar gnusutil-read-coding-system nil
  "Coding-system for reading articles of the current news group.")
(defvar gnusutil-subject nil)
(defvar gnusutil-encoded-subject nil)
(defvar gnusutil-original-subject nil)
(defvar gnusutil-article-mode-line-leader nil)

(defun gnusutil-code-convert1 (start end coding-system encoding)
  (if (< start end)
      (save-excursion
       (if encoding
	   (code-convert start end coding-system *internal*)
	 (code-convert start end *internal* coding-system)))))

(defun gnusutil-code-convert (coding-system encoding)
  "Convert the current buffer while keeping (window-start) and (point)."
  (if coding-system
      (let ((win (get-buffer-window (current-buffer))))
	(if win
	    ;; We should keep (point) and (window-start).
	    (save-window-excursion
	      (select-window win)
	      (if encoding
		  ;; Simple way to assure point is on valid character boundary.
		  (beginning-of-line))
	      (gnusutil-code-convert1 (point-min) (window-start)
				      coding-system encoding)
	      (gnusutil-code-convert1 (window-start) (point)
				      coding-system encoding)
	      (gnusutil-code-convert1 (point) (point-max)
				      coding-system encoding)
	      (if (not (pos-visible-in-window-p))
		  ;; point went out of window, move to the bottom of window.
		  (move-to-window-line -1)))
	  ;; No window for the buffer,
	  ;; no need to worry about (point) nor (windos-start).
	  (gnusutil-code-convert1 (point-min) (point-max)
				  coding-system encoding))
	)))

(defun gnusutil-truncate-subject (subject maxclm &optional coding-system)
  "Truncate SUBJECT to fit in COLUMN width.
Also convert \"%\" to \"%%\" to escape from %-constructs in mode-line.
If optional third arg CODING-SYSTEM is non-nil,
 SUBJECT is converted to the original."
  (let ((len (string-width subject))
	(buf (get-buffer-create " *gnusutil-work-buf*"))
	 clm)
    (save-excursion
      (set-buffer buf)
      (setq mc-flag (not coding-system))
      (erase-buffer)
      (insert subject)
      (if coding-system
	  (code-convert (point-min) (point-max) *internal* coding-system))
      (goto-char (point-min))
      (end-of-line)
      (setq clm (current-column))
      (if (< clm maxclm)
	  ;; insert padding spaces
	  (insert-char ?  (- maxclm clm))
	(if (> clm maxclm)
	    ;; subject too long
	    (progn
	      (move-to-column maxclm)
	      (forward-char -1)
	      (insert-char ?. (- maxclm (current-column))))))
      (delete-region (point) (point-max))
      ;; convert % -> %%
      (goto-char (point-min))
      (while (search-forward "%" nil t)
	(insert ?%))
      (buffer-string))))

(defconst gnusutil-article-mode-line
  '("GNUS: "
    gnusutil-article-mode-line-leader
    (gnusutil-article-encoded
     gnusutil-encoded-subject gnusutil-original-subject))
  "mode-line-buffer-identification for *Article* buffer.")

(defun gnusutil-article-set-mode-line ()
  "Set Article mode line string. (revised by 'gnusutil')"
  ;; At first, prepare leader ...
  (setq gnusutil-article-mode-line-leader
	(format "%s/%s " gnus-newsgroup-name gnus-current-article))
  ;; then, prepare subject ...
  (let* ((maxlen 17))			;Maximum subject length
    ;; 'gnusutil-subject' is set in gnusutil-article-prepare-hook
    (if (null gnusutil-subject)
	;; No subject, just make padding string
	(setq gnusutil-original-subject (make-string maxlen ? )
	      gnusutil-encoded-subject gnusutil-original-subject)
      ;; Article selected and has subject.  Now modify it for mode-line.
      ;; The subject has already encoded. 
      (setq gnusutil-encoded-subject
	    (gnusutil-truncate-subject gnusutil-subject maxlen))
      ;; Prepare original subject.
      (setq gnusutil-original-subject
	    (if gnusutil-read-coding-system
		(gnusutil-truncate-subject gnusutil-subject maxlen
					   gnusutil-read-coding-system)
	      gnusutil-encoded-subject))))
  (setq mode-line-buffer-identification gnusutil-article-mode-line)
  (set-buffer-modified-p t))

(defun gnusutil-retrieve-headers (arg)
  ;; Replacement for gnus-retrieve-headers.
  ;; I couldn't find a hook to do this work.
  (let* ((file-coding-system-for-read *noconv*)
	 (headers (gnusutil-retrieve-headers-orig arg))
	 (coding-system (gnusutil-get-coding-system gnus-newsgroup-name)))
    ;; At first, set coding-system for the current group.
    (setq gnusutil-read-coding-system
	  (if (and coding-system (coding-system-p (car coding-system)))
	      (car coding-system)))
    ;; Try to encode subjects of the current group.
    (if gnusutil-read-coding-system
	(mapcar
	 '(lambda (header)		; Don't compile me!
	    (nntp-set-header-subject
	     header
	     (code-convert-string (nntp-header-subject header)
				  gnusutil-read-coding-system *internal*)))
	 headers))
    headers
    ))

(defun gnusutil-request-article (arg)
  ;; Replacement for gnus-request-article
  ;; I couldn't find a hook to do this work.
  (let ((file-coding-system-for-read *noconv*))
    (gnusutil-request-article-orig arg)))

(defun gnusutil-Open-server-hook ()
  ;; Don't convert code while reading from files.
  (fset 'gnusutil-retrieve-headers-orig
	(symbol-function 'gnus-retrieve-headers))
  (fset 'gnus-retrieve-headers
	(symbol-function 'gnusutil-retrieve-headers))
  (fset 'gnusutil-request-article-orig
	(symbol-function 'gnus-request-article))
  (fset 'gnus-request-article
	(symbol-function 'gnusutil-request-article))
  )

(defun gnusutil-Select-group-hook ()
  ;; At first, get coding-system for the current group.
  (let ((coding-system (gnusutil-get-coding-system gnus-newsgroup-name)))
    (setq gnusutil-read-coding-system
	  (if (and coding-system (coding-system-p (car coding-system)))
	      (car coding-system))))
  ;; Then, try to encode subjects of the current group.
  (if gnusutil-read-coding-system
      (mapcar
       '(lambda (header)		; Don't compile me!
	  (nntp-set-header-subject
	   header
	   (code-convert-string (nntp-header-subject header)
				gnusutil-read-coding-system *internal*)))
       gnus-newsgroup-headers)))

(defun gnusutil-article-prepare-hook ()
  (setq gnusutil-subject
	(if gnus-current-headers
	    (eval '(nntp-header-subject gnus-current-headers))))
  (gnusutil-code-convert gnusutil-read-coding-system t)
  (setq gnusutil-article-encoded t))

;;I gave up toggling encode of Subject because it requires too dirty code.
;;(defun gnusutil-toggle-summary-format ()
;;  (interactive)
;;  (let (buffer-read-only)
;;    (setq gnusutil-summary-encoded (not gnusutil-summary-encoded))
;;    (gnusutil-code-convert gnusutil-read-coding-system
;;			   gnusutil-summary-encoded)
;;    (set-buffer-modified-p t)))

(defun gnusutil-toggle-article-format ()
  "Toggle encoding of *Article* buffer."
  (interactive)
  (let ((curbuf (current-buffer))
	(buf (if (boundp 'gnus-article-buffer) ;93.11.19 by Y.Kawabe
		 (get-buffer gnus-article-buffer)
	       (get-buffer gnus-Article-buffer))))
    (if (and gnusutil-read-coding-system buf)
	(progn
	  (set-buffer buf)
	  (let ((modif (buffer-modified-p))
		buffer-read-only)
	    (setq gnusutil-article-encoded (not gnusutil-article-encoded))
	    (gnusutil-code-convert gnusutil-read-coding-system
				   gnusutil-article-encoded)
	    (set-buffer-modified-p modif))
	  (set-buffer curbuf)))))

(defun gnusutil-inews-article-hook ()
  (let ((ng (mail-fetch-field "newsgroups")))
    (if ng
	(let ((coding-system (cdr (gnusutil-get-coding-system ng))))
	  (if coding-system
	      (gnusutil-code-convert coding-system nil))))))

(defvar gnusutil-initialize-hook nil
  "A hook function called just after settings of gnusutil are done.")

;;;###autoload
(defun gnusutil-initialize ()
  "Do several settings for GNUS to enable automatic code conversion."
  ;; Communicate with nntp daemon without any code conversion
  (define-service-coding-system gnus-nntp-service nil *noconv*)
  ;; Convenient key definitions
  ;(define-key gnus-summary-mode-map "Z" 'gnusutil-toggle-summary-format)
  (if (boundp 'gnus-summary-mode-map)
      (define-key gnus-summary-mode-map "z" 'gnusutil-toggle-article-format)
    (define-key gnus-Subject-mode-map "z" 'gnusutil-toggle-article-format))
  ;; Better function definition
  (if (fboundp 'gnus-article-set-mode-line)
      (fset 'gnus-article-set-mode-line
	    (symbol-function 'gnusutil-article-set-mode-line))
    (fset 'gnus-Article-set-mode-line
	  (symbol-function 'gnusutil-article-set-mode-line)))
  ;; Hook definition
  (if (boundp 'gnus-open-server-hook)
      (progn
	(add-hook 'gnus-open-server-hook
		  'gnusutil-Open-server-hook)
	(add-hook 'gnus-article-prepare-hook
		  'gnusutil-article-prepare-hook)
	;; Use append mode to execute gnusutil-inews-article-hook last.
	(add-hook 'gnus-inews-article-hook
		  'gnusutil-inews-article-hook 'append))
    (add-hook 'gnus-Open-server-hook
	      'gnusutil-Open-server-hook)
    (add-hook 'gnus-Article-prepare-hook
	      'gnusutil-article-prepare-hook)
    (add-hook 'gnus-Inews-article-hook
	      'gnusutil-inews-article-hook 'append))
  ;; All setting are done.  Now call hook.
  (run-hooks 'gnusutil-initialize-hook))

(gnusutil-add-group "" '*junet*unix) ;; default coding system
(gnusutil-add-group "alt" '*noconv*)
(gnusutil-add-group "comp" '*noconv*)
(gnusutil-add-group "gnu" '*noconv*)
(gnusutil-add-group "rec" '*noconv*)
(gnusutil-add-group "sci" '*noconv*)
(gnusutil-add-group "soc" '*noconv*)
(gnusutil-add-group "alt.chinese.text" '*hz*)
(gnusutil-add-group "alt.hk" '*hz*)
(gnusutil-add-group "alt.chinese.text.big5" '*big5-eten*unix)
(gnusutil-add-group "soc.culture.vietnamese" '(nil *viqr*))

;; Special treatment for fj.editor.mule
(gnusutil-add-group "fj.editor.mule" '*fj*)

(make-coding-system
 '*fj* 0
 ?F "Coding-system used in fj.editor.mule."
 nil)

(defconst fj-valid-esc-seq		; 93.9.28 by K.Handa
  "\\([NO]\\|\\$\\([@AB]\\|\([CD]\\)\\|[(*][BJ]\\|\\.[AFH]\\)")

(defconst fj-printable-equal (format "=%2x" ?=))
(defconst fj-printable-esc (format "=%2x" ?\e))
(defconst fj-mule-special-heading
  "### Mule special encoding for fj.editor.mule ###\n")

(defun fj-pre-write-conversion (from to)
  (goto-char from)
  (search-forward "\n\n" nil t)
  (save-restriction
    (narrow-to-region (point) to)
    (code-convert-region (point-min) (point-max) *internal* *iso-2022-ss2-7*)
    (goto-char (point-min))
    (let (invalid-sequence-found)
      (while (and (not invalid-sequence-found)
		  (search-forward "\e" nil t))
	(setq invalid-sequence-found
	      (not (looking-at fj-valid-esc-seq))))
      (if invalid-sequence-found
	  (progn
	    (goto-char (point-min))
	    (insert fj-mule-special-heading)
	    (while (search-forward "=" nil t)
	      (replace-match fj-printable-equal t t))
	    (goto-char (point-min))
	    (while (search-forward "\e" nil t)
	      (if (looking-at fj-valid-esc-seq)
		  nil
		(delete-char -1)
		(insert fj-printable-esc))))))))

(defun fj-post-read-conversion (from to)
  (save-excursion
    (goto-char from)
    (search-forward "\n\n" nil t)
    (save-restriction
      (narrow-to-region (point) to)
      (if (looking-at (format "^%s" (regexp-quote fj-mule-special-heading)))
	  (progn
	    (goto-char (point-min))
	    (while (search-forward fj-printable-esc nil t)
	      (replace-match "\e" t t))
	    (goto-char (point-min))
	    (while (search-forward fj-printable-equal nil t)
	      (replace-match "=" t t))))
      (code-convert-region (point-min) (point-max)
			   *iso-2022-ss2-7* *internal*))))

(put *fj* 'post-read-conversion 'fj-post-read-conversion)
(put *fj* 'pre-write-conversion 'fj-pre-write-conversion)

(defvar gnus-Group-mode-hook 'gnusutil-initialize)
(defvar gnus-group-mode-hook 'gnusutil-initialize)

(provide 'gnusutil)