cgit.sxemacs.org Git - packages/blob - xemacs-packages/tm/gnus-charset.el

   1 ;;; gnus-charset.el --- MIME charset extension for Gnus
   2
   3 ;; Copyright (C) 1995,1996 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Created: 1996/8/6
   7 ;; Version:
   8 ;;      $Id: gnus-charset.el,v 1.1.1.1 1998-01-14 06:27:57 steve Exp $
   9 ;; Keywords: news, MIME, multimedia, multilingual, encoded-word
  10
  11 ;; This file is not part of GNU Emacs yet.
  12
  13 ;; This program is free software; you can redistribute it and/or
  14 ;; modify it under the terms of the GNU General Public License as
  15 ;; published by the Free Software Foundation; either version 2, or (at
  16 ;; your option) any later version.
  17
  18 ;; This program is distributed in the hope that it will be useful, but
  19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 ;; General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Code:
  29
  30 (require 'gnus)
  31 ;; Don't ask and I won't tell ... :-( :-( :-( :-(
  32 (eval-when-compile (require 'emu))
  33
  34 (defvar gnus-is-red-gnus-or-later
  35   (or (featurep 'gnus-load)
  36       (module-installed-p 'gnus-sum)
  37       ))
  38
  39
  40 ;;; @ newsgroup default charset
  41 ;;;
  42
  43 (defvar gnus-newsgroup-default-charset-alist nil)
  44
  45 (defun gnus-set-newsgroup-default-charset (newsgroup charset)
  46   "Set CHARSET for the NEWSGROUP as default MIME charset."
  47   (let* ((ng-regexp (concat "^" (regexp-quote newsgroup) "\\($\\|\\.\\)"))
  48          (pair (assoc ng-regexp gnus-newsgroup-default-charset-alist))
  49          )
  50     (if pair
  51         (setcdr pair charset)
  52       (setq gnus-newsgroup-default-charset-alist
  53             (cons (cons ng-regexp charset)
  54                   gnus-newsgroup-default-charset-alist))
  55       )))
  56
  57
  58 ;;; @ for mule (Multilingual support)
  59 ;;;
  60
  61 (cond
  62  ((featurep 'mule)
  63   (require 'emu)
  64   (defvar nntp-open-binary-connection-function
  65     (if gnus-is-red-gnus-or-later
  66         ;; maybe Red Gnus
  67         (if (boundp 'nntp-open-connection-function)
  68             nntp-open-connection-function
  69           'nntp-open-network-stream)
  70       ;; maybe Gnus 5.[01] or Gnus 5.[23]
  71       (if (boundp 'nntp-open-server-function)
  72           nntp-open-server-function
  73         'nntp-open-network-stream)
  74       ))
  75   (defun nntp-open-network-stream-with-no-code-conversion (&rest args)
  76     (let ((proc (apply nntp-open-binary-connection-function args)))
  77       (set-process-input-coding-system proc *noconv*)
  78       proc))
  79   (if gnus-is-red-gnus-or-later
  80       (setq nntp-open-connection-function
  81             'nntp-open-network-stream-with-no-code-conversion)
  82     (setq nntp-open-server-function
  83           'nntp-open-network-stream-with-no-code-conversion)
  84     )
  85   (call-after-loaded
  86    'nnheader
  87    (lambda ()
  88      (defun nnheader-find-file-noselect (&rest args)
  89        (as-binary-input-file
  90         (let ((format-alist nil)
  91               (auto-mode-alist (nnheader-auto-mode-alist))
  92               (default-major-mode 'fundamental-mode)
  93               (after-insert-file-functions ; for jam-code-guess
  94                (if (memq 'jam-code-guess-after-insert-file-function
  95                          after-insert-file-functions)
  96                    '(jam-code-guess-after-insert-file-function))))
  97           (apply 'find-file-noselect args)))
  98        )
  99      ;; Red Gnus 0.67 or later
 100      (defun nnheader-insert-file-contents
 101        (filename &optional visit beg end replace)
 102        (as-binary-input-file
 103         (let ((format-alist nil)
 104               (auto-mode-alist (nnheader-auto-mode-alist))
 105               (default-major-mode 'fundamental-mode)
 106               (enable-local-variables nil)
 107               (after-insert-file-functions ; for jam-code-guess
 108                (if (memq 'jam-code-guess-after-insert-file-function
 109                          after-insert-file-functions)
 110                    '(jam-code-guess-after-insert-file-function))))
 111           (insert-file-contents filename visit beg end replace))
 112         )
 113        ;; for gnspool on OS/2
 114        (while (re-search-forward "\r$" nil t)
 115          (replace-match "")
 116          )
 117        )
 118      ;; imported from Red Gnus 0.66
 119      (or (fboundp 'nnheader-auto-mode-alist)
 120          (defun nnheader-auto-mode-alist ()
 121            (let ((alist auto-mode-alist)
 122                  out)
 123              (while alist
 124                (when (listp (cdar alist))
 125                  (push (car alist) out))
 126                (pop alist))
 127              (nreverse out)))
 128          )
 129      ;; alias for Old Gnus
 130      (defalias 'nnheader-insert-file-contents-literally
 131        'nnheader-insert-file-contents)
 132      ))
 133   (call-after-loaded
 134    'nnmail
 135    (lambda ()
 136      (defun nnmail-find-file (file)
 137        "Insert FILE in server buffer safely. [gnus-charset.el]"
 138        (set-buffer nntp-server-buffer)
 139        (erase-buffer)
 140        (let ((format-alist nil)
 141              (after-insert-file-functions   ; for jam-code-guess
 142               (if (memq 'jam-code-guess-after-insert-file-function
 143                         after-insert-file-functions)
 144                   '(jam-code-guess-after-insert-file-function)))
 145              )
 146          (as-binary-input-file
 147           (condition-case ()
 148               (progn (insert-file-contents file) t)
 149             (file-error nil))
 150           )))
 151      ))
 152   (defun gnus-prepare-save-mail-function ()
 153     (setq file-coding-system *noconv*
 154           buffer-file-coding-system 'no-conversion)
 155     )
 156   (add-hook 'nnmail-prepare-save-mail-hook
 157             'gnus-prepare-save-mail-function)
 158
 159   (gnus-set-newsgroup-default-charset "alt.chinese" 'hz-gb-2312)
 160   (gnus-set-newsgroup-default-charset "alt.chinese.text.big5" 'cn-big5)
 161   (gnus-set-newsgroup-default-charset "fj"      'iso-2022-jp-2)
 162   (gnus-set-newsgroup-default-charset "han"     'euc-kr)
 163   (gnus-set-newsgroup-default-charset "hk"      'cn-big5)
 164   (gnus-set-newsgroup-default-charset "hkstar"  'cn-big5)
 165   (gnus-set-newsgroup-default-charset "relcom"  'koi8-r)
 166   (gnus-set-newsgroup-default-charset "tw"      'cn-big5)
 167   ))
 168
 169
 170 ;;; @ end
 171 ;;;
 172
 173 (provide 'gnus-charset)
 174
 175 ;;; gnus-charset.el ends here