lisp/gnus/gnus-rfc1843.el

   1 ;;; gnus-rfc1843.el --- HZ (rfc1843) decoding interface functions for Gnus
   2
   3 ;; Copyright (C) 1998-2017 Free Software Foundation, Inc.
   4
   5 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
   6 ;; Keywords: news HZ HZ+ mail i18n
   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 3 of the License, or
  13 ;; (at your option) 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.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; Usage:
  26 ;; (require 'gnus-rfc1843)
  27 ;; (rfc1843-gnus-setup)
  28
  29 ;;; Code:
  30
  31 (require 'rfc1843)
  32 (require 'gnus-sum)
  33 (require 'gnus-art)
  34 (require 'message)
  35
  36 (defun rfc1843-decode-article-body ()
  37   "Decode HZ encoded text in the article body."
  38   (if (string-match (concat "\\<\\(" rfc1843-newsgroups-regexp "\\)\\>")
  39                     (or gnus-newsgroup-name ""))
  40       (save-excursion
  41         (save-restriction
  42           (message-narrow-to-head)
  43           (let* ((inhibit-point-motion-hooks t)
  44                  (case-fold-search t)
  45                  (ct (message-fetch-field "Content-Type" t))
  46                  (ctl (and ct (mail-header-parse-content-type ct))))
  47             (if (and ctl (not (string-match "/" (car ctl))))
  48                 (setq ctl nil))
  49             (goto-char (point-max))
  50             (widen)
  51             (forward-line 1)
  52             (narrow-to-region (point) (point-max))
  53             (when (or (not ctl)
  54                       (equal (car ctl) "text/plain"))
  55               (rfc1843-decode-region (point) (point-max))))))))
  56
  57 (defun rfc1843-gnus-setup ()
  58   "Setup HZ decoding for Gnus."
  59   (add-hook 'gnus-article-decode-hook 'rfc1843-decode-article-body t)
  60   (setq gnus-decode-encoded-word-function
  61         'gnus-multi-decode-encoded-word-string
  62         gnus-decode-header-function
  63         'gnus-multi-decode-header
  64         gnus-decode-encoded-word-methods
  65         (nconc gnus-decode-encoded-word-methods
  66                (list
  67                 (cons (concat "\\<\\(" rfc1843-newsgroups-regexp "\\)\\>")
  68                       'rfc1843-decode-string)))
  69         gnus-decode-header-methods
  70         (nconc gnus-decode-header-methods
  71                (list
  72                 (cons (concat "\\<\\(" rfc1843-newsgroups-regexp "\\)\\>")
  73                       'rfc1843-decode-region)))))
  74
  75 (provide 'gnus-rfc1843)
  76
  77 ;;; gnus-rfc1843.el ends here