lisp/gnus/gnus-mule.el

   1 ;;; gnus-mule.el --- Provide multilingual environment to GNUS
   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
  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 ;; 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)
  34 ;;
  35 ;; Decoding of summary buffer is not yet implemented.
  36
  37 (require 'gnus)
  38
  39 (defvar gnus-newsgroup-coding-systems nil
  40   "Assoc list of news groups vs corresponding coding systems.
  41 Each element is a list of news group name and cons of coding systems
  42 for reading and posting.")
  43
  44 ;;;###autoload
  45 (defun gnus-mule-add-group (name coding-system)
  46   "Specify that articles of news group NAME are encoded in CODING-SYSTEM.
  47 All news groups deeper than NAME are also the target.
  48 If CODING-SYSTEM is a cons, the car and cdr part are regarded as
  49 coding-system for reading and writing respectively."
  50   (if (not (consp coding-system))
  51       (setq coding-system (cons coding-system coding-system)))
  52   (setq name (concat "^" (regexp-quote name)))
  53   (let ((group (assoc name gnus-newsgroup-coding-systems)))
  54     (if group
  55         (setcdr group coding-system)
  56       (setq gnus-newsgroup-coding-systems
  57             (cons (cons name coding-system) gnus-newsgroup-coding-systems)))))
  58
  59 (defun gnus-mule-get-coding-system (group)
  60   "Return the coding system for news group GROUP."
  61   (let ((groups gnus-newsgroup-coding-systems)
  62         (len -1)
  63         coding-system)
  64     ;; Find an entry which matches GROUP the best (i.e. longest).
  65     (while groups
  66       (if (and (string-match (car (car groups)) group)
  67                (> (match-end 0) len))
  68           (setq len (match-end 0)
  69                 coding-system (cdr (car groups))))
  70       (setq groups (cdr groups)))
  71     coding-system))
  72
  73 ;; Flag to indicate if article buffer is already decoded or not.")
  74 (defvar gnus-mule-article-decoded nil)
  75 ;; Codingsystem for reading articles of the current news group.
  76 (defvar gnus-mule-coding-system nil)
  77 (defvar gnus-mule-subject nil)
  78 (defvar gnus-mule-decoded-subject nil)
  79 (defvar gnus-mule-original-subject nil)
  80
  81 ;; Encode (if ENCODING is t) or decode (if ENCODING is nil)  the
  82 ;; region from START to END by CODING-SYSTEM.
  83 (defun gnus-mule-code-convert1 (start end coding-system encoding)
  84   (if (< start end)
  85       (save-excursion
  86        (if encoding
  87            (encode-coding-region start end coding-system)
  88          (decode-coding-region start end coding-system)))))
  89
  90 ;; Encode (if ENCODING is t) or decode (if ENCODING is nil) the
  91 ;; current buffer by CODING-SYSTEM.  Try not to move positions of
  92 ;; (window-start) and (point).
  93 (defun gnus-mule-code-convert (coding-system encoding)
  94   (if coding-system
  95       (let ((win (get-buffer-window (current-buffer))))
  96         (if win
  97             ;; We should keep (point) and (window-start).
  98             (save-window-excursion
  99               (select-window win)
 100               (if encoding
 101                   ;; Simple way to assure point is on valid character boundary.
 102                   (beginning-of-line))
 103               (gnus-mule-code-convert1 (point-min) (window-start)
 104                                        coding-system encoding)
 105               (gnus-mule-code-convert1 (window-start) (point)
 106                                        coding-system encoding)
 107               (gnus-mule-code-convert1 (point) (point-max)
 108                                        coding-system encoding)
 109               (if (not (pos-visible-in-window-p))
 110                   ;; point went out of window, move to the bottom of window.
 111                   (move-to-window-line -1)))
 112           ;; No window for the buffer, no need to worry about (point)
 113           ;; and (windos-start).
 114           (gnus-mule-code-convert1 (point-min) (point-max)
 115                                    coding-system encoding))
 116         )))
 117
 118 ;; Set `gnus-mule-coding-system' to the coding system articles of the
 119 ;; current news group is encoded.   This function is set in
 120 ;; `gnus-select-group-hook'.
 121 (defun gnus-mule-select-coding-system ()
 122   (let ((coding-system (gnus-mule-get-coding-system gnus-newsgroup-name)))
 123     (setq gnus-mule-coding-system
 124           (if (and coding-system (coding-system-p (car coding-system)))
 125               (car coding-system)))))
 126
 127 ;; Decode the current article.  This function is set in
 128 ;; `gnus-article-prepare-hook'.
 129 (defun gnus-mule-decode-article ()
 130   (gnus-mule-code-convert gnus-mule-coding-system nil)
 131   (setq gnus-mule-article-decoded t))
 132
 133 ;; Decode the current summary buffer.  This function is set in
 134 ;; `gnus-summary-generate-hook'.
 135 ;; Made by <sangil@hugsvr.kaist.ac.kr>,
 136 ;; coded by <crisp@hugsvr.kaist.ac.kr>.
 137 (defun gnus-mule-decode-summary ()
 138   (if gnus-mule-coding-system
 139       (mapcar
 140        (lambda (headers)
 141          (let ((subject (aref headers 1))
 142                (author  (aref headers 2)))
 143            (aset headers 1
 144                  (decode-coding-string subject gnus-mule-coding-system))
 145            (aset headers 2
 146                  (decode-coding-string author gnus-mule-coding-system))))
 147        gnus-newsgroup-headers)))
 148
 149 (defun gnus-mule-toggle-article-format ()
 150   "Toggle decoding/encoding of the current article buffer."
 151   (interactive)
 152   (let ((buf (get-buffer gnus-article-buffer)))
 153     (if (and gnus-mule-coding-system buf)
 154         (save-excursion
 155           (set-buffer buf)
 156           (let ((modif (buffer-modified-p))
 157                 buffer-read-only)
 158             (gnus-mule-code-convert gnus-mule-coding-system
 159                                    gnus-mule-article-decoded)
 160             (setq gnus-mule-article-decoded (not gnus-mule-article-decoded))
 161             (set-buffer-modified-p modif))))))
 162
 163 ;;;###autoload
 164 (defun gnus-mule-initialize ()
 165   "Do several settings for GNUS to enable automatic code conversion."
 166   ;; Convenient key definitions
 167   (define-key gnus-article-mode-map "z" 'gnus-mule-toggle-article-format)
 168   (define-key gnus-summary-mode-map "z" 'gnus-mule-toggle-article-format)
 169   ;; Hook definition
 170   (add-hook 'gnus-select-group-hook 'gnus-mule-select-coding-system)
 171   (add-hook 'gnus-summary-generate-hook 'gnus-mule-decode-summary)
 172   (add-hook 'gnus-article-prepare-hook 'gnus-mule-decode-article))
 173
 174 (gnus-mule-add-group "" 'iso-2022-7) ;; default coding system
 175 (gnus-mule-add-group "alt" 'no-conversion)
 176 (gnus-mule-add-group "comp" 'no-conversion)
 177 (gnus-mule-add-group "gnu" 'no-conversion)
 178 (gnus-mule-add-group "rec" 'no-conversion)
 179 (gnus-mule-add-group "sci" 'no-conversion)
 180 (gnus-mule-add-group "soc" 'no-conversion)
 181 (gnus-mule-add-group "alt.chinese.text" 'hz-gb-2312)
 182 (gnus-mule-add-group "alt.hk" 'hz-gb-2312)
 183 (gnus-mule-add-group "alt.chinese.text.big5" 'cn-big5)
 184 (gnus-mule-add-group "soc.culture.vietnamese" '(nil . viqr))
 185
 186 (add-hook 'gnus-startup-hook 'gnus-mule-initialize)
 187
 188 ;; gnus-mule.el ends here