summaryrefslogtreecommitdiff
path: root/lisp/gnus/gnus-mule.el
blob: 13062278ce847cb16500605d703fb183e6ee49ad (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
;;; 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 "tnn" 'iso-2022-7bit)
(gnus-mule-add-group "japan" 'iso-2022-7bit)
(gnus-mule-add-group "pin" '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