lisp/gnus/gnus-mule.el

   1 ;;; gnus-mule.el --- Provide multilingual environment to GNUS
   2
   3 ;; Copyright (C) 1995,1997 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
  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.
  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 ;; If you want to specify some coding system for a specific news
  30 ;; group, add the fllowing line in your .emacs:
  31 ;;      (gnus-mule-add-group "xxx.yyy.zzz" 'some-coding-system)
  32
  33 ;; By default, only few news groups are registered as the target of
  34 ;; code conversion.  So, each regional users had better set an
  35 ;; appropriate coding system for as below:
  36 ;;      (gnus-mule-add-group "" 'iso-2022-jp)  ;; the case for Japanese
  37
  38 (require 'nntp)
  39
  40 (defvar gnus-newsgroup-coding-systems nil
  41   "Assoc list of news groups vs corresponding coding systems.
  42 Each element is has the form (PATTERN CODING-FOR-READ . CODING-FOR-POST),
  43 where,
  44 PATTERN is a regular expression matching news group names,
  45 CODING-FOR-READ is a coding system of articles of the news groups, and
  46 CODING-FOR-POST is a coding system to be encoded for posting articles
  47 to the news groups.")
  48
  49 ;;;###autoload
  50 (defun gnus-mule-add-group (name coding-system)
  51   "Specify that articles of news group NAME are encoded in CODING-SYSTEM.
  52 All news groups deeper than NAME are also the target.
  53 If CODING-SYSTEM is a cons, the car and cdr part are regarded as
  54 coding-system for reading and writing respectively."
  55   (if (not (consp coding-system))
  56       (setq coding-system (cons coding-system coding-system)))
  57   (setq name (concat "^" (regexp-quote name)))
  58   (let ((group (assoc name gnus-newsgroup-coding-systems)))
  59     (if group
  60         (setcdr group coding-system)
  61       (setq gnus-newsgroup-coding-systems
  62             (cons (cons name coding-system) gnus-newsgroup-coding-systems)))))
  63
  64 (defun gnus-mule-get-coding-system (group)
  65   "Return the coding system for news group GROUP."
  66   (let ((groups gnus-newsgroup-coding-systems)
  67         (len -1)
  68         coding-system)
  69     ;; Find an entry which matches GROUP the best (i.e. longest).
  70     (while groups
  71       (if (and (string-match (car (car groups)) group)
  72                (> (match-end 0) len))
  73           (setq len (match-end 0)
  74                 coding-system (cdr (car groups))))
  75       (setq groups (cdr groups)))
  76     coding-system))
  77
  78 ;; Flag to indicate if article buffer is already decoded or not.")
  79 (defvar gnus-mule-article-decoded nil)
  80 ;; Coding system for reading articles of the current news group.
  81 (defvar gnus-mule-coding-system nil)
  82 ;;(make-variable-buffer-local 'gnus-mule-coding-system)
  83 (defvar gnus-mule-subject nil)
  84 (defvar gnus-mule-decoded-subject nil)
  85 (defvar gnus-mule-original-subject nil)
  86
  87 ;; Encode (if ENCODING is t) or decode (if ENCODING is nil)  the
  88 ;; region from START to END by CODING-SYSTEM.
  89 (defun gnus-mule-code-convert1 (start end coding-system encoding)
  90   (if (< start end)
  91       (save-excursion
  92        (if encoding
  93            (encode-coding-region start end coding-system)
  94          (decode-coding-region start end coding-system)))))
  95
  96 ;; Encode (if ENCODING is t) or decode (if ENCODING is nil) the
  97 ;; current buffer by CODING-SYSTEM.  Try not to move positions of
  98 ;; (window-start) and (point).
  99 (defun gnus-mule-code-convert (coding-system encoding)
 100   (if coding-system
 101       (let ((win (get-buffer-window (current-buffer))))
 102         (if win
 103             ;; We should keep (point) and (window-start).
 104             (save-window-excursion
 105               (select-window win)
 106               (if encoding
 107                   ;; Simple way to assure point is on valid character boundary.
 108                   (beginning-of-line))
 109               (gnus-mule-code-convert1 (point-min) (window-start)
 110                                        coding-system encoding)
 111               (gnus-mule-code-convert1 (window-start) (point)
 112                                        coding-system encoding)
 113               (gnus-mule-code-convert1 (point) (point-max)
 114                                        coding-system encoding)
 115               (if (not (pos-visible-in-window-p))
 116                   ;; point went out of window, move to the bottom of window.
 117                   (move-to-window-line -1)))
 118           ;; No window for the buffer, no need to worry about (point)
 119           ;; and (windos-start).
 120           (gnus-mule-code-convert1 (point-min) (point-max)
 121                                    coding-system encoding))
 122         )))
 123
 124 ;; Set `gnus-mule-coding-system' to the coding system articles of the
 125 ;; current news group is encoded.   This function is set in
 126 ;; `gnus-parse-headers-hook'.
 127 (defun gnus-mule-select-coding-system ()
 128   (if (gnus-buffer-live-p gnus-summary-buffer)
 129       (save-excursion
 130         (set-buffer gnus-summary-buffer)
 131         (let ((coding-system
 132                (gnus-mule-get-coding-system gnus-newsgroup-name)))
 133           (setq gnus-mule-coding-system
 134                 (if (and coding-system (coding-system-p (car coding-system)))
 135                     (car coding-system)))))
 136     'binary))
 137
 138 ;; Decode the current article.  This function is set in
 139 ;; `gnus-show-traditional-method'.
 140 (defun gnus-mule-decode-article ()
 141   (gnus-mule-code-convert gnus-mule-coding-system nil)
 142   (setq gnus-mule-article-decoded t))
 143
 144 (defun gnus-mule-toggle-article-format ()
 145   "Toggle decoding/encoding of the current article buffer."
 146   (interactive)
 147   (let ((buf (get-buffer gnus-article-buffer)))
 148     (if (and gnus-mule-coding-system buf)
 149         (save-excursion
 150           (set-buffer buf)
 151           (let ((modif (buffer-modified-p))
 152                 buffer-read-only)
 153             (gnus-mule-code-convert gnus-mule-coding-system
 154                                    gnus-mule-article-decoded)
 155             (setq gnus-mule-article-decoded (not gnus-mule-article-decoded))
 156             (set-buffer-modified-p modif))))))
 157
 158 ;; Encode a news article before sending it.
 159 (defun gnus-mule-message-send-news-function ()
 160   (let ((groups (message-fetch-field "newsgroups"))
 161         (idx 0)
 162         coding-system coding-system-list group-list)
 163     (if (not groups)
 164         ;; We are not sending the current buffer via news.
 165         nil
 166       (while (string-match "[^ ,]+" groups idx)
 167         (setq idx (match-end 0))
 168         (setq coding-system
 169               (cdr (gnus-mule-get-coding-system
 170                     (substring groups (match-beginning 0) idx))))
 171         (if (not (memq coding-system coding-system-list))
 172             (setq coding-system-list (cons coding-system coding-system-list))))
 173       (if (> (length coding-system-list) 1)
 174           (setq coding-system (read-coding-system "Coding system: ")))
 175       (if coding-system
 176           (encode-coding-region (point-min) (point-max) coding-system)))))
 177
 178 ;; Encode a mail message before sending it.
 179 (defun gnus-mule-message-send-mail-function ()
 180   (let ((coding (if enable-multibyte-characters
 181                     (select-message-coding-system))))
 182     (if coding
 183         (encode-coding-region (point-min) (point-max) coding))))
 184
 185 ;;;###autoload
 186 (defun gnus-mule-initialize ()
 187   "Do several settings for GNUS to enable automatic code conversion."
 188   ;; Convenient key definitions
 189   (define-key gnus-article-mode-map "z" 'gnus-mule-toggle-article-format)
 190   (define-key gnus-summary-mode-map "z" 'gnus-mule-toggle-article-format)
 191   ;; Hook definition
 192   (add-hook 'gnus-parse-headers-hook 'gnus-mule-select-coding-system)
 193   (add-hook 'message-send-news-hook
 194             'gnus-mule-message-send-news-function)
 195   (add-hook 'message-send-mail-hook
 196             'gnus-mule-message-send-mail-function)
 197   (setq nnheader-file-coding-system 'binary
 198         nnmail-file-coding-system   'binary)
 199   )
 200
 201 (gnus-mule-add-group "" 'iso-latin-1)
 202 (gnus-mule-add-group "fj" 'iso-2022-7bit)
 203 (gnus-mule-add-group "tnn" 'iso-2022-7bit)
 204 (gnus-mule-add-group "japan" 'iso-2022-7bit)
 205 (gnus-mule-add-group "pin" 'iso-2022-7bit)
 206 (gnus-mule-add-group "han" 'euc-kr)
 207 (gnus-mule-add-group "alt.chinese.text" 'chinese-hz)
 208 (gnus-mule-add-group "alt.hk" 'chinese-hz)
 209 (gnus-mule-add-group "alt.chinese.text.big5" 'chinese-big5)
 210 (gnus-mule-add-group "soc.culture.vietnamese" '(nil . vietnamese-viqr))
 211 (gnus-mule-add-group "relcom" 'cyrillic-koi8)
 212 (gnus-mule-add-group "tw." 'chinese-big5)
 213
 214 (provide 'gnus-mule)
 215
 216 ;; gnus-mule.el ends here