lisp/international/rfc1843.el

   1 ;;; rfc1843.el --- HZ (rfc1843) decoding  -*- lexical-binding:t -*-
   2
   3 ;; Copyright (C) 1998-2019 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 <https://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-lib))
  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   :type 'boolean
  59   :group 'mime)
  60
  61 (defcustom rfc1843-newsgroups-regexp "chinese\\|hz"
  62   "Regexp of newsgroups in which might be HZ encoded."
  63   :type 'string
  64   :group 'mime)
  65
  66 (defun rfc1843-decode-region (from to)
  67   "Decode HZ in the region between FROM and TO."
  68   (interactive "r")
  69   (let (str firstc)
  70     (save-excursion
  71       (goto-char from)
  72       (if (or rfc1843-decode-loosely
  73               (re-search-forward (if rfc1843-decode-hzp
  74                                      rfc1843-hzp-word-regexp-strictly
  75                                    rfc1843-word-regexp-strictly) to t))
  76           (save-restriction
  77             (narrow-to-region from to)
  78             (goto-char (point-min))
  79             (while (re-search-forward (if rfc1843-decode-hzp
  80                                           rfc1843-hzp-word-regexp
  81                                         rfc1843-word-regexp) (point-max) t)
  82               (setq str (buffer-substring-no-properties
  83                          (match-beginning 1)
  84                          (match-end 1)))
  85               (setq firstc (aref str 0))
  86               (insert (decode-coding-string
  87                        (rfc1843-decode
  88                         (prog1
  89                             (substring str 1)
  90                           (delete-region (match-beginning 0) (match-end 0)))
  91                         firstc)
  92                        (if (eq firstc ?{) 'cn-gb-2312 'cn-big5))))
  93             (goto-char (point-min))
  94             (while (search-forward "~" (point-max) t)
  95               (cond ((eq (char-after) ?\n)
  96                      (delete-char -1)
  97                      (delete-char 1))
  98                     ((eq (char-after) ?~)
  99                      (delete-char 1)))))))))
 100
 101 (defun rfc1843-decode-string (string)
 102   "Decode HZ STRING and return the results."
 103   (let ((m enable-multibyte-characters))
 104     (with-temp-buffer
 105       (when m
 106         (set-buffer-multibyte 'to))
 107       (insert string)
 108       (inline
 109         (rfc1843-decode-region (point-min) (point-max)))
 110       (buffer-string))))
 111
 112 (defun rfc1843-decode (word &optional firstc)
 113   "Decode HZ WORD and return it."
 114   (let ((i -1) (s (substring word 0)) v)
 115     (if (or (not firstc) (eq firstc ?{))
 116         (while (< (cl-incf i) (length s))
 117           (if (eq (setq v (aref s i)) ? ) nil
 118             (aset s i (+ 128 v))))
 119       (while (< (cl-incf i) (length s))
 120         (if (eq (setq v (aref s i)) ? ) nil
 121           (setq v (+ (* 94 v) (aref s (1+ i)) -3135))
 122           (aset s i (+ (/ v 157) (if (eq firstc ?<) 201 161)))
 123           (setq v (% v 157))
 124           (aset s (cl-incf i) (+ v (if (< v 63) 64 98))))))
 125     s))
 126
 127 (provide 'rfc1843)
 128
 129 ;;; rfc1843.el ends here