code.delx.au - gnu-emacs/blob - lisp/international/rfc1843.el

   1 ;;; rfc1843.el --- HZ (rfc1843) decoding
   2
   3 ;; Copyright (C) 1998-2016 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 ;; Test:
  26 ;; (rfc1843-decode-string  "~{<:Ky2;S{#,NpJ)l6HK!#~}")
  27
  28 ;;; Code:
  29
  30 (eval-when-compile (require 'cl))
  31
  32 (defvar rfc1843-word-regexp
  33   "~\\({\\([\041-\167][\041-\176]\\| \\)+\\)\\(~}\\|$\\)")
  34
  35 (defvar rfc1843-word-regexp-strictly
  36   "~\\({\\([\041-\167][\041-\176]\\)+\\)\\(~}\\|$\\)")
  37
  38 (defvar rfc1843-hzp-word-regexp
  39   "~\\({\\([\041-\167][\041-\176]\\| \\)+\\|\
  40 [<>]\\([\041-\175][\041-\176]\\| \\)+\\)\\(~}\\|$\\)")
  41
  42 (defvar rfc1843-hzp-word-regexp-strictly
  43   "~\\({\\([\041-\167][\041-\176]\\)+\\|\
  44 [<>]\\([\041-\175][\041-\176]\\)+\\)\\(~}\\|$\\)")
  45
  46 (defcustom rfc1843-decode-loosely nil
  47   "Loosely check HZ encoding if non-nil.
  48 When it is set non-nil, only buffers or strings with strictly
  49 HZ-encoded are decoded."
  50   :type 'boolean
  51   :group 'mime)
  52
  53 (defcustom rfc1843-decode-hzp t
  54   "HZ+ decoding support if non-nil.
  55 HZ+ specification (also known as HZP) is to provide a standardized
  56 7-bit representation of mixed Big5, GB, and ASCII text for convenient
  57 e-mail transmission, news posting, etc.
  58 The document of HZ+ 0.78 specification can be found at
  59 ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc"
  60   :type 'boolean
  61   :group 'mime)
  62
  63 (defcustom rfc1843-newsgroups-regexp "chinese\\|hz"
  64   "Regexp of newsgroups in which might be HZ encoded."
  65   :type 'string
  66   :group 'mime)
  67
  68 (defun rfc1843-decode-region (from to)
  69   "Decode HZ in the region between FROM and TO."
  70   (interactive "r")
  71   (let (str firstc)
  72     (save-excursion
  73       (goto-char from)
  74       (if (or rfc1843-decode-loosely
  75               (re-search-forward (if rfc1843-decode-hzp
  76                                      rfc1843-hzp-word-regexp-strictly
  77                                    rfc1843-word-regexp-strictly) to t))
  78           (save-restriction
  79             (narrow-to-region from to)
  80             (goto-char (point-min))
  81             (while (re-search-forward (if rfc1843-decode-hzp
  82                                           rfc1843-hzp-word-regexp
  83                                         rfc1843-word-regexp) (point-max) t)
  84               (setq str (buffer-substring-no-properties
  85                          (match-beginning 1)
  86                          (match-end 1)))
  87               (setq firstc (aref str 0))
  88               (insert (decode-coding-string
  89                        (rfc1843-decode
  90                         (prog1
  91                             (substring str 1)
  92                           (delete-region (match-beginning 0) (match-end 0)))
  93                         firstc)
  94                        (if (eq firstc ?{) 'cn-gb-2312 'cn-big5))))
  95             (goto-char (point-min))
  96             (while (search-forward "~" (point-max) t)
  97               (cond ((eq (char-after) ?\n)
  98                      (delete-char -1)
  99                      (delete-char 1))
 100                     ((eq (char-after) ?~)
 101                      (delete-char 1)))))))))
 102
 103 (defun rfc1843-decode-string (string)
 104   "Decode HZ STRING and return the results."
 105   (let ((m enable-multibyte-characters))
 106     (with-temp-buffer
 107       (when m
 108         (set-buffer-multibyte 'to))
 109       (insert string)
 110       (inline
 111         (rfc1843-decode-region (point-min) (point-max)))
 112       (buffer-string))))
 113
 114 (defun rfc1843-decode (word &optional firstc)
 115   "Decode HZ WORD and return it."
 116   (let ((i -1) (s (substring word 0)) v)
 117     (if (or (not firstc) (eq firstc ?{))
 118         (while (< (incf i) (length s))
 119           (if (eq (setq v (aref s i)) ? ) nil
 120             (aset s i (+ 128 v))))
 121       (while (< (incf i) (length s))
 122         (if (eq (setq v (aref s i)) ? ) nil
 123           (setq v (+ (* 94 v) (aref s (1+ i)) -3135))
 124           (aset s i (+ (/ v 157) (if (eq firstc ?<) 201 161)))
 125           (setq v (% v 157))
 126           (aset s (incf i) (+ v (if (< v 63) 64 98))))))
 127     s))
 128
 129 (provide 'rfc1843)
 130
 131 ;;; rfc1843.el ends here