X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Frfc1843.el;h=2bce3143c93e8b43a03155165fc2e3b2ab44fc35;hb=85be3726901ca453647897e26330fee8aa25d8c0;hp=adf475df16d7c57c329566551a9e7f5ecd509771;hpb=ee70a66fb20ed12d43960dd3933c7f416257ef42;p=elisp%2Fgnus.git- diff --git a/lisp/rfc1843.el b/lisp/rfc1843.el index adf475d..2bce314 100644 --- a/lisp/rfc1843.el +++ b/lisp/rfc1843.el @@ -1,10 +1,12 @@ ;;; rfc1843.el --- HZ (rfc1843) decoding -;; Copyright (c) 1998,1999 by Shenghuo Zhu + +;; Copyright (C) 1998, 1999, 2000, 2002, 2003, 2004, +;; 2005 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu -;; Keywords: news HZ +;; Keywords: news HZ HZ+ mail i18n -;; This file is a 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 @@ -18,8 +20,8 @@ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -32,28 +34,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. @@ -63,12 +70,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." @@ -86,7 +93,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 @@ -100,8 +110,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." @@ -115,7 +125,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)) @@ -130,26 +140,26 @@ ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc" s)) (defun rfc1843-decode-article-body () - "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 (ignore-errors - (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)))))))) + "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 (ignore-errors + (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 rfc1843-old-gnus-decode-header-function nil) (defvar gnus-decode-header-methods)