[bpt/emacs.git] / lisp / gnus / gnus-mule.el

;;; gnus-mule.el --- Provide multilingual environment to GNUS

;; Copyright (C) 1995 Free Software Foundation, Inc.
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.

;; Keywords: gnus, mule

;; This file is part of GNU Emacs.

;; GNU Emacs 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.

;; GNU Emacs 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:

;; 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:
;;	(add-hook 'gnus-startup-hook 'gnus-mule-initialize)
;; If you want to specify some coding system for a specific news
;; group, add the fllowing line in your .emacs:
;;	(gnus-mule-add-group "xxx.yyy.zzz" 'some-coding-system)

;; By default, only few news groups are registered as the target of
;; code conversion.  So, each regional users had better set an
;; appropriate coding system for as below:
;;	(gnus-mule-add-group "" 'iso-2022-jp)  ;; the case for Japanese

(require 'gnus)
(require 'message)

(defvar gnus-newsgroup-coding-systems nil
  "Assoc list of news groups vs corresponding coding systems.
Each element is has the form (PATTERN CODING-FOR-READ . CODING-FOR-POST),
where,
PATTERN is a regular expression matching news group names,
CODING-FOR-READ is a coding system of articles of the news groups, and
CODING-FOR-POST is a coding system to be encoded for posting articles
to the news groups.")

;;;###autoload
(defun gnus-mule-add-group (name coding-system)
  "Specify that articles of news group NAME are encoded in CODING-SYSTEM.
All news groups deeper than NAME are also the target.
If CODING-SYSTEM is a cons, the car and cdr part are regarded as
coding-system for reading and writing respectively."
  (if (not (consp coding-system))
      (setq coding-system (cons coding-system coding-system)))
  (setq name (concat "^" (regexp-quote name)))
  (let ((group (assoc name gnus-newsgroup-coding-systems)))
    (if group
	(setcdr group coding-system)
      (setq gnus-newsgroup-coding-systems
	    (cons (cons name coding-system) gnus-newsgroup-coding-systems)))))

(defun gnus-mule-get-coding-system (group)
  "Return the coding system for news group GROUP."
  (let ((groups gnus-newsgroup-coding-systems)
	(len -1)
	coding-system)
    ;; Find an entry which matches GROUP the best (i.e. longest).
    (while groups
      (if (and (string-match (car (car groups)) group)
	       (> (match-end 0) len))
	  (setq len (match-end 0)
		coding-system (cdr (car groups))))
      (setq groups (cdr groups)))
    coding-system))

;; Flag to indicate if article buffer is already decoded or not.")
(defvar gnus-mule-article-decoded nil)
;; Coding system for reading articles of the current news group.
(defvar gnus-mule-coding-system nil)
(defvar gnus-mule-subject nil)
(defvar gnus-mule-decoded-subject nil)
(defvar gnus-mule-original-subject nil)

;; Encode (if ENCODING is t) or decode (if ENCODING is nil)  the
;; region from START to END by CODING-SYSTEM.
(defun gnus-mule-code-convert1 (start end coding-system encoding)
  (if (< start end)
      (save-excursion
       (if encoding
	   (encode-coding-region start end coding-system)
	 (decode-coding-region start end coding-system)))))

;; Encode (if ENCODING is t) or decode (if ENCODING is nil) the
;; current buffer by CODING-SYSTEM.  Try not to move positions of
;; (window-start) and (point).
(defun gnus-mule-code-convert (coding-system encoding)
  (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))
	      (gnus-mule-code-convert1 (point-min) (window-start)
				       coding-system encoding)
	      (gnus-mule-code-convert1 (window-start) (point)
				       coding-system encoding)
	      (gnus-mule-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)
	  ;; and (windos-start).
	  (gnus-mule-code-convert1 (point-min) (point-max)
				   coding-system encoding))
	)))

;; Set `gnus-mule-coding-system' to the coding system articles of the
;; current news group is encoded.   This function is set in
;; `gnus-select-group-hook'.
(defun gnus-mule-select-coding-system ()
  (let ((coding-system (gnus-mule-get-coding-system gnus-newsgroup-name)))
    (setq gnus-mule-coding-system
	  (if (and coding-system (coding-system-p (car coding-system)))
	      (car coding-system)))))

;; Decode the current article.  This function is set in
;; `gnus-article-prepare-hook'.
(defun gnus-mule-decode-article ()
  (gnus-mule-code-convert gnus-mule-coding-system nil)
  (setq gnus-mule-article-decoded t))

;; Decode the current summary buffer.  This function is set in
;; `gnus-summary-generate-hook'.
;; Made by <sangil@hugsvr.kaist.ac.kr>,
;; coded by <crisp@hugsvr.kaist.ac.kr>.
(defun gnus-mule-decode-summary ()
  (if gnus-mule-coding-system 
      (mapcar 
       (lambda (headers)
         (let ((subject (aref headers 1))
               (author  (aref headers 2)))
           (aset headers 1 
                 (decode-coding-string subject gnus-mule-coding-system))
           (aset headers 2
                 (decode-coding-string author gnus-mule-coding-system))))
       gnus-newsgroup-headers)))

(defun gnus-mule-toggle-article-format ()
  "Toggle decoding/encoding of the current article buffer."
  (interactive)
  (let ((buf (get-buffer gnus-article-buffer)))
    (if (and gnus-mule-coding-system buf)
	(save-excursion
	  (set-buffer buf)
	  (let ((modif (buffer-modified-p))
		buffer-read-only)
	    (gnus-mule-code-convert gnus-mule-coding-system
				   gnus-mule-article-decoded)
	    (setq gnus-mule-article-decoded (not gnus-mule-article-decoded))
	    (set-buffer-modified-p modif))))))

;; Encode a news article before sending it.
(defun gnus-mule-message-send-news-function ()
  (let ((groups (message-fetch-field "newsgroups"))
	(idx 0)
	coding-system coding-system-list group-list)
    (if (not groups)
	;; We are not sending the current buffer via news.
	nil
      (while (string-match "[^ ,]+" groups idx)
	(setq idx (match-end 0))
	(setq coding-system
	      (cdr (gnus-mule-get-coding-system
		    (substring groups (match-beginning 0) idx))))
	(if (not (memq coding-system coding-system-list))
	    (setq coding-system-list (cons coding-system coding-system-list))))
      (if (> (length coding-system-list) 1)
	  (setq coding-system (read-coding-system "Coding system: ")))
      (if coding-system
	  (encode-coding-region (point-min) (point-max) coding-system)))))

;; Encode a mail message before sending it.
(defun gnus-mule-message-send-mail-function ()
  (if sendmail-coding-system
      (encode-coding-region (point-min) (point-max) sendmail-coding-system)))

;;;###autoload
(defun gnus-mule-initialize ()
  "Do several settings for GNUS to enable automatic code conversion."
  ;; Convenient key definitions
  (define-key gnus-article-mode-map "z" 'gnus-mule-toggle-article-format)
  (define-key gnus-summary-mode-map "z" 'gnus-mule-toggle-article-format)
  ;; Hook definition
  (add-hook 'gnus-select-group-hook 'gnus-mule-select-coding-system)
  (add-hook 'gnus-summary-generate-hook 'gnus-mule-decode-summary)
  (add-hook 'gnus-article-prepare-hook 'gnus-mule-decode-article)
  (add-hook 'message-send-news-hook
	    'gnus-mule-message-send-news-function)
  (add-hook 'message-send-mail-hook
	    'gnus-mule-message-send-mail-function))

(gnus-mule-add-group "" 'undecided)
(gnus-mule-add-group "fj" 'iso-2022-7bit)
(gnus-mule-add-group "alt.chinese.text" 'chinese-hz)
(gnus-mule-add-group "alt.hk" 'chinese-hz)
(gnus-mule-add-group "alt.chinese.text.big5" 'chinese-big5)
(gnus-mule-add-group "soc.culture.vietnamese" '(nil . vietnamese-viqr))
(gnus-mule-add-group "relcom" 'cyrillic-koi8)

(add-hook 'gnus-startup-hook 'gnus-mule-initialize)

;; gnus-mule.el ends here
Commit	Line	Data
3fdc9c8f	1	;;; gnus-mule.el --- Provide multilingual environment to GNUS
4ed46869 KH	2
	3	;; Copyright (C) 1995 Free Software Foundation, Inc.
	4	;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
	5
	6	;; Keywords: gnus, mule
	7
	8	;; This file is part of GNU Emacs.
	9
	10	;; GNU Emacs is free software; you can redistribute it and/or modify
	11	;; it under the terms of the GNU General Public License as published by
	12	;; the Free Software Foundation; either version 2, or (at your option)
	13	;; any later version.
	14
	15	;; GNU Emacs is distributed in the hope that it will be useful,
	16	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	17	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	18	;; GNU General Public License for more details.
	19
	20	;; You should have received a copy of the GNU General Public License
369314dc KH	21	;; along with GNU Emacs; see the file COPYING. If not, write to the
	22	;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
	23	;; Boston, MA 02111-1307, USA.
4ed46869 KH	24
	25	;;; Commentary:
	26
	27	;; This package enables GNUS to code convert automatically
	28	;; accoding to a coding system specified for each news group.
	29	;; Please put the following line in your .emacs:
	30	;; (add-hook 'gnus-startup-hook 'gnus-mule-initialize)
	31	;; If you want to specify some coding system for a specific news
	32	;; group, add the fllowing line in your .emacs:
	33	;; (gnus-mule-add-group "xxx.yyy.zzz" 'some-coding-system)
8d691399 KH	34
	35	;; By default, only few news groups are registered as the target of
	36	;; code conversion. So, each regional users had better set an
	37	;; appropriate coding system for as below:
	38	;; (gnus-mule-add-group "" 'iso-2022-jp) ;; the case for Japanese
4ed46869 KH	39
4ed46869 KH	40	(require 'gnus)
8d691399	41	(require 'message)
4ed46869 KH	42
	43	(defvar gnus-newsgroup-coding-systems nil
	44	"Assoc list of news groups vs corresponding coding systems.
8d691399 KH	45	Each element is has the form (PATTERN CODING-FOR-READ . CODING-FOR-POST),
	46	where,
	47	PATTERN is a regular expression matching news group names,
	48	CODING-FOR-READ is a coding system of articles of the news groups, and
	49	CODING-FOR-POST is a coding system to be encoded for posting articles
	50	to the news groups.")
4ed46869 KH	51
	52	;;;###autoload
	53	(defun gnus-mule-add-group (name coding-system)
	54	"Specify that articles of news group NAME are encoded in CODING-SYSTEM.
	55	All news groups deeper than NAME are also the target.
	56	If CODING-SYSTEM is a cons, the car and cdr part are regarded as
	57	coding-system for reading and writing respectively."
	58	(if (not (consp coding-system))
	59	(setq coding-system (cons coding-system coding-system)))
	60	(setq name (concat "^" (regexp-quote name)))
	61	(let ((group (assoc name gnus-newsgroup-coding-systems)))
	62	(if group
	63	(setcdr group coding-system)
	64	(setq gnus-newsgroup-coding-systems
	65	(cons (cons name coding-system) gnus-newsgroup-coding-systems)))))
	66
	67	(defun gnus-mule-get-coding-system (group)
	68	"Return the coding system for news group GROUP."
	69	(let ((groups gnus-newsgroup-coding-systems)
	70	(len -1)
	71	coding-system)
	72	;; Find an entry which matches GROUP the best (i.e. longest).
	73	(while groups
	74	(if (and (string-match (car (car groups)) group)
	75	(> (match-end 0) len))
	76	(setq len (match-end 0)
	77	coding-system (cdr (car groups))))
	78	(setq groups (cdr groups)))
	79	coding-system))
	80
	81	;; Flag to indicate if article buffer is already decoded or not.")
	82	(defvar gnus-mule-article-decoded nil)
8d691399	83	;; Coding system for reading articles of the current news group.
4ed46869 KH	84	(defvar gnus-mule-coding-system nil)
	85	(defvar gnus-mule-subject nil)
	86	(defvar gnus-mule-decoded-subject nil)
	87	(defvar gnus-mule-original-subject nil)
	88
	89	;; Encode (if ENCODING is t) or decode (if ENCODING is nil) the
	90	;; region from START to END by CODING-SYSTEM.
	91	(defun gnus-mule-code-convert1 (start end coding-system encoding)
	92	(if (< start end)
	93	(save-excursion
	94	(if encoding
	95	(encode-coding-region start end coding-system)
	96	(decode-coding-region start end coding-system)))))
	97
	98	;; Encode (if ENCODING is t) or decode (if ENCODING is nil) the
	99	;; current buffer by CODING-SYSTEM. Try not to move positions of
	100	;; (window-start) and (point).
	101	(defun gnus-mule-code-convert (coding-system encoding)
	102	(if coding-system
	103	(let ((win (get-buffer-window (current-buffer))))
	104	(if win
	105	;; We should keep (point) and (window-start).
	106	(save-window-excursion
	107	(select-window win)
	108	(if encoding
	109	;; Simple way to assure point is on valid character boundary.
	110	(beginning-of-line))
	111	(gnus-mule-code-convert1 (point-min) (window-start)
	112	coding-system encoding)
	113	(gnus-mule-code-convert1 (window-start) (point)
	114	coding-system encoding)
	115	(gnus-mule-code-convert1 (point) (point-max)
	116	coding-system encoding)
	117	(if (not (pos-visible-in-window-p))
	118	;; point went out of window, move to the bottom of window.
	119	(move-to-window-line -1)))
	120	;; No window for the buffer, no need to worry about (point)
	121	;; and (windos-start).
	122	(gnus-mule-code-convert1 (point-min) (point-max)
	123	coding-system encoding))
	124	)))
	125
	126	;; Set `gnus-mule-coding-system' to the coding system articles of the
	127	;; current news group is encoded. This function is set in
	128	;; `gnus-select-group-hook'.
	129	(defun gnus-mule-select-coding-system ()
	130	(let ((coding-system (gnus-mule-get-coding-system gnus-newsgroup-name)))
	131	(setq gnus-mule-coding-system
	132	(if (and coding-system (coding-system-p (car coding-system)))
	133	(car coding-system)))))
	134
	135	;; Decode the current article. This function is set in
	136	;; `gnus-article-prepare-hook'.
	137	(defun gnus-mule-decode-article ()
	138	(gnus-mule-code-convert gnus-mule-coding-system nil)
	139	(setq gnus-mule-article-decoded t))
	140
	141	;; Decode the current summary buffer. This function is set in
a1a45cd2 KH	142	;; `gnus-summary-generate-hook'.
	143	;; Made by <sangil@hugsvr.kaist.ac.kr>,
	144	;; coded by <crisp@hugsvr.kaist.ac.kr>.
4ed46869	145	(defun gnus-mule-decode-summary ()
a1a45cd2 KH	146	(if gnus-mule-coding-system
	147	(mapcar
	148	(lambda (headers)
	149	(let ((subject (aref headers 1))
	150	(author (aref headers 2)))
	151	(aset headers 1
	152	(decode-coding-string subject gnus-mule-coding-system))
	153	(aset headers 2
	154	(decode-coding-string author gnus-mule-coding-system))))
	155	gnus-newsgroup-headers)))
4ed46869 KH	156
	157	(defun gnus-mule-toggle-article-format ()
	158	"Toggle decoding/encoding of the current article buffer."
	159	(interactive)
	160	(let ((buf (get-buffer gnus-article-buffer)))
	161	(if (and gnus-mule-coding-system buf)
	162	(save-excursion
	163	(set-buffer buf)
	164	(let ((modif (buffer-modified-p))
	165	buffer-read-only)
	166	(gnus-mule-code-convert gnus-mule-coding-system
	167	gnus-mule-article-decoded)
	168	(setq gnus-mule-article-decoded (not gnus-mule-article-decoded))
	169	(set-buffer-modified-p modif))))))
	170
8d691399 KH	171	;; Encode a news article before sending it.
	172	(defun gnus-mule-message-send-news-function ()
	173	(let ((groups (message-fetch-field "newsgroups"))
	174	(idx 0)
	175	coding-system coding-system-list group-list)
	176	(if (not groups)
	177	;; We are not sending the current buffer via news.
	178	nil
	179	(while (string-match "[^ ,]+" groups idx)
	180	(setq idx (match-end 0))
	181	(setq coding-system
	182	(cdr (gnus-mule-get-coding-system
	183	(substring groups (match-beginning 0) idx))))
	184	(if (not (memq coding-system coding-system-list))
	185	(setq coding-system-list (cons coding-system coding-system-list))))
	186	(if (> (length coding-system-list) 1)
	187	(setq coding-system (read-coding-system "Coding system: ")))
	188	(if coding-system
	189	(encode-coding-region (point-min) (point-max) coding-system)))))
	190
	191	;; Encode a mail message before sending it.
	192	(defun gnus-mule-message-send-mail-function ()
	193	(if sendmail-coding-system
	194	(encode-coding-region (point-min) (point-max) sendmail-coding-system)))
	195
4ed46869 KH	196	;;;###autoload
	197	(defun gnus-mule-initialize ()
	198	"Do several settings for GNUS to enable automatic code conversion."
	199	;; Convenient key definitions
	200	(define-key gnus-article-mode-map "z" 'gnus-mule-toggle-article-format)
	201	(define-key gnus-summary-mode-map "z" 'gnus-mule-toggle-article-format)
	202	;; Hook definition
	203	(add-hook 'gnus-select-group-hook 'gnus-mule-select-coding-system)
a1a45cd2	204	(add-hook 'gnus-summary-generate-hook 'gnus-mule-decode-summary)
8d691399 KH	205	(add-hook 'gnus-article-prepare-hook 'gnus-mule-decode-article)
	206	(add-hook 'message-send-news-hook
	207	'gnus-mule-message-send-news-function)
	208	(add-hook 'message-send-mail-hook
	209	'gnus-mule-message-send-mail-function))
	210
426591c3	211	(gnus-mule-add-group "" 'undecided)
3ea2f73c KH	212	(gnus-mule-add-group "fj" 'iso-2022-7bit)
	213	(gnus-mule-add-group "alt.chinese.text" 'chinese-hz)
	214	(gnus-mule-add-group "alt.hk" 'chinese-hz)
	215	(gnus-mule-add-group "alt.chinese.text.big5" 'chinese-big5)
	216	(gnus-mule-add-group "soc.culture.vietnamese" '(nil . vietnamese-viqr))
	217	(gnus-mule-add-group "relcom" 'cyrillic-koi8)
4ed46869 KH	218
	219	(add-hook 'gnus-startup-hook 'gnus-mule-initialize)
	220
	221	;; gnus-mule.el ends here