X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Frfc1843.el;h=cab2f4e751c85efb018fb30a694cbecf4807933b;hp=03d461123fe81e33b0f2291d637e88b7c8249742;hb=2c102003004f4fa3dd5fe1f56c66936f386c4359;hpb=397e18023881a13e1448bad3c1db0a02026cf864 diff --git a/lisp/rfc1843.el b/lisp/rfc1843.el index 03d461123..cab2f4e75 100644 --- a/lisp/rfc1843.el +++ b/lisp/rfc1843.el @@ -1,28 +1,24 @@ ;;; rfc1843.el --- HZ (rfc1843) decoding -;; Copyright (c) 1998 by Shenghuo Zhu + +;; Copyright (C) 1998-2015 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu -;; $Revision: 5.2 $ -;; Keywords: news HZ -;; Time-stamp: +;; Keywords: news HZ HZ+ mail i18n -;; This file is not part of GNU Emacs, but the same permissions -;; apply. +;; 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 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 3 of the License, 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. +;; 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. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -35,28 +31,33 @@ ;;; Code: +(eval-when-compile (require 'cl)) (require 'mm-util) +(defvar gnus-decode-encoded-word-function) +(defvar gnus-decode-header-function) +(defvar gnus-newsgroup-name) + (defvar rfc1843-word-regexp - "~\\({\\([\041-\167][\041-\176]\\| \\)+\\(~}\\|$\\)") + "~\\({\\([\041-\167][\041-\176]\\| \\)+\\)\\(~}\\|$\\)") (defvar rfc1843-word-regexp-strictly - "~\\({\\([\041-\167][\041-\176]\\)+\\(~}\\|$\\)") + "~\\({\\([\041-\167][\041-\176]\\)+\\)\\(~}\\|$\\)") (defvar rfc1843-hzp-word-regexp "~\\({\\([\041-\167][\041-\176]\\| \\)+\\|\ -[<>]\\([\041-\175][\041-\176]\\| \\)+\\)\\(~}\\|$\\)") +\[<>]\\([\041-\175][\041-\176]\\| \\)+\\)\\(~}\\|$\\)") (defvar rfc1843-hzp-word-regexp-strictly - "~\\({\\([\041-\167][\041-\176]\\)+\\|\ -[<>]\\([\041-\175][\041-\176]\\)+\\)\\(~}\\|$\\)") + "~\\({\\([\041-\167][\041-\176]\\)+\\|\ +\[<>]\\([\041-\175][\041-\176]\\)+\\)\\(~}\\|$\\)") (defcustom rfc1843-decode-loosely nil "Loosely check HZ encoding if non-nil. When it is set non-nil, only buffers or strings with strictly HZ-encoded are decoded." :type 'boolean - :group 'gnus) + :group 'mime) (defcustom rfc1843-decode-hzp t "HZ+ decoding support if non-nil. @@ -66,12 +67,12 @@ e-mail transmission, news posting, etc. The document of HZ+ 0.78 specification can be found at ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc" :type 'boolean - :group 'gnus) + :group 'mime) (defcustom rfc1843-newsgroups-regexp "chinese\\|hz" "Regexp of newsgroups in which might be HZ encoded." :type 'string - :group 'gnus) + :group 'mime) (defun rfc1843-decode-region (from to) "Decode HZ in the region between FROM and TO." @@ -89,7 +90,10 @@ ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc" (while (re-search-forward (if rfc1843-decode-hzp rfc1843-hzp-word-regexp rfc1843-word-regexp) (point-max) t) - (setq str (match-string 1)) + ;;; Text with extents may cause XEmacs crash + (setq str (buffer-substring-no-properties + (match-beginning 1) + (match-end 1))) (setq firstc (aref str 0)) (insert (mm-decode-coding-string (rfc1843-decode @@ -103,8 +107,8 @@ ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc" (cond ((eq (char-after) ?\n) (delete-char -1) (delete-char 1)) - ((eq (char-after) ?~) - (delete-char 1))))))))) + ((eq (char-after) ?~) + (delete-char 1))))))))) (defun rfc1843-decode-string (string) "Decode HZ STRING and return the results." @@ -118,7 +122,7 @@ ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc" (buffer-string)))) (defun rfc1843-decode (word &optional firstc) - "Decode HZ WORD and return it" + "Decode HZ WORD and return it." (let ((i -1) (s (substring word 0)) v) (if (or (not firstc) (eq firstc ?{)) (while (< (incf i) (length s)) @@ -132,18 +136,31 @@ ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc" (aset s (incf i) (+ v (if (< v 63) 64 98)))))) s)) +(autoload 'mail-header-parse-content-type "mail-parse") +(autoload 'message-narrow-to-head "message") +(declare-function message-fetch-field "message" (header &optional not-all)) + (defun rfc1843-decode-article-body () - "Decode HZ encoded text in the article body." - (if (string-match (concat "\\<\\(" rfc1843-newsgroups-regexp "\\)\\>") - gnus-newsgroup-name) - (save-excursion - (save-restriction - (message-narrow-to-head) - (goto-char (point-max)) - (widen) - (rfc1843-decode-region (point) (point-max)))))) - -(defvar rfc1843-old-gnus-decode-header-function nil) + "Decode HZ encoded text in the article body." + (if (string-match (concat "\\<\\(" rfc1843-newsgroups-regexp "\\)\\>") + (or gnus-newsgroup-name "")) + (save-excursion + (save-restriction + (message-narrow-to-head) + (let* ((inhibit-point-motion-hooks t) + (case-fold-search t) + (ct (message-fetch-field "Content-Type" t)) + (ctl (and ct (mail-header-parse-content-type ct)))) + (if (and ctl (not (string-match "/" (car ctl)))) + (setq ctl nil)) + (goto-char (point-max)) + (widen) + (forward-line 1) + (narrow-to-region (point) (point-max)) + (when (or (not ctl) + (equal (car ctl) "text/plain")) + (rfc1843-decode-region (point) (point-max)))))))) + (defvar gnus-decode-header-methods) (defvar gnus-decode-encoded-word-methods)