git.chise.org Git - elisp/gnus.git-/blob - lisp/qp.el

   1 ;;; qp.el --- Quoted-Printable functions
   2
   3 ;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
   4
   5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   6 ;; Keywords: mail, extensions
   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 2, or (at your option)
  13 ;; 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; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; Functions for encoding and decoding quoted-printable text as
  28 ;; defined in RFC 2045.
  29
  30 ;;; Code:
  31
  32 (require 'mm-util)
  33 (eval-when-compile (defvar mm-use-ultra-safe-encoding))
  34
  35 (defun quoted-printable-decode-region (from to &optional coding-system)
  36   "Decode quoted-printable in the region between FROM and TO, per RFC 2045.
  37 If CODING-SYSTEM is non-nil, decode bytes into characters with that
  38 coding-system."
  39   (interactive "r")
  40   (unless (mm-coding-system-p coding-system) ; e.g. `ascii' from Gnus
  41     (setq coding-system nil))
  42   (save-excursion
  43     (save-restriction
  44       ;; RFC 2045:  ``An "=" followed by two hexadecimal digits, one
  45       ;; or both of which are lowercase letters in "abcdef", is
  46       ;; formally illegal. A robust implementation might choose to
  47       ;; recognize them as the corresponding uppercase letters.''
  48       (let ((case-fold-search t))
  49         (narrow-to-region from to)
  50         ;; Do this in case we're called from Gnus, say, in a buffer
  51         ;; which already contains non-ASCII characters which would
  52         ;; then get doubly-decoded below.
  53         (if coding-system
  54             (mm-encode-coding-region (point-min) (point-max) coding-system))
  55         (goto-char (point-min))
  56         (while (and (skip-chars-forward "^=")
  57                     (not (eobp)))
  58           (cond ((eq (char-after (1+ (point))) ?\n)
  59                  (delete-char 2))
  60                 ((looking-at "=[0-9A-F][0-9A-F]")
  61                  (let ((byte (string-to-int (buffer-substring (1+ (point))
  62                                                               (+ 3 (point)))
  63                                             16)))
  64                    (insert byte)
  65                    (delete-char 3)
  66                    ;; Why backward-char???
  67                    ;;(unless (eq byte 61) ;; 61 is not ?= in XEmacs
  68                    ;;  (backward-char))
  69                    ))
  70                 (t
  71                  (error "Malformed quoted-printable text")
  72                  (forward-char)))))
  73       (if coding-system
  74           (mm-decode-coding-region (point-min) (point-max) coding-system)))))
  75
  76 (defun quoted-printable-decode-string (string &optional coding-system)
  77   "Decode the quoted-printable encoded STRING and return the result.
  78 If CODING-SYSTEM is non-nil, decode the region with coding-system."
  79   (with-temp-buffer
  80     (insert string)
  81     (quoted-printable-decode-region (point-min) (point-max) coding-system)
  82     (buffer-string)))
  83
  84 (defun quoted-printable-encode-region (from to &optional fold class)
  85   "Quoted-printable encode the region between FROM and TO per RFC 2045.
  86
  87 If FOLD, fold long lines at 76 characters (as required by the RFC).
  88 If CLASS is non-nil, translate the characters matched by that class in
  89 the form expected by `skip-chars-forward'.
  90
  91 If `mm-use-ultra-safe-encoding' is set, fold lines unconditionally and
  92 encode lines starting with \"From\"."
  93   (interactive "r")
  94   (unless class
  95     ;; Avoid using 8bit characters. = is \075.
  96     ;; Equivalent to "^\000-\007\013\015-\037\200-\377="
  97     (setq class "\010-\012\014\040-\074\076-\177"))
  98   (if (fboundp 'string-as-multibyte)
  99       (setq class (string-as-multibyte class)))
 100   (save-excursion
 101     (save-restriction
 102       (narrow-to-region from to)
 103       (mm-with-unibyte-current-buffer-mule4
 104         (if (and (not (featurep 'xemacs)) ;; Don't check XEmacs Mule.
 105                  (fboundp 'find-charset-region))
 106             (if (delq 'unknown          ; Emacs 20 unibyte
 107                       (delq 'eight-bit-graphic ; Emacs 21
 108                             (delq 'eight-bit-control
 109                                   (delq 'ascii
 110                                         (find-charset-region from to)))))
 111                 (error "Multibyte character in QP encoding region")))
 112         ;; Encode all the non-ascii and control characters.
 113         (goto-char (point-min))
 114         (while (and (skip-chars-forward class)
 115                     (not (eobp)))
 116           (insert
 117            (prog1
 118                (format "=%02X" (char-after))
 119              (delete-char 1))))
 120         ;; Encode white space at the end of lines.
 121         (goto-char (point-min))
 122         (while (re-search-forward "[ \t]+$" nil t)
 123           (goto-char (match-beginning 0))
 124           (while (not (eolp))
 125             (insert
 126              (prog1
 127                  (format "=%02X" (char-after))
 128                (delete-char 1)))))
 129         (let ((mm-use-ultra-safe-encoding
 130                (and (boundp 'mm-use-ultra-safe-encoding)
 131                     mm-use-ultra-safe-encoding)))
 132           (when (or fold mm-use-ultra-safe-encoding)
 133             ;; Fold long lines.
 134             (let ((tab-width 1))                ; HTAB is one character.
 135               (goto-char (point-min))
 136               (while (not (eobp))
 137                 ;; In ultra-safe mode, encode "From " at the beginning
 138                 ;; of a line.
 139                 (when mm-use-ultra-safe-encoding
 140                   (beginning-of-line)
 141                   (if (looking-at "From ")
 142                       (replace-match "From=20" nil t)
 143                     (if (looking-at "-")
 144                         (replace-match "=2D" nil t))))
 145                 (end-of-line)
 146               (while (> (current-column) 76) ; tab-width must be 1.
 147                 (beginning-of-line)
 148                 (forward-char 75)       ; 75 chars plus an "="
 149                 (search-backward "=" (- (point) 2) t)
 150                 (insert "=\n")
 151                 (end-of-line))
 152               (unless (eobp)
 153                 (forward-line))))))))))
 154
 155 (defun quoted-printable-encode-string (string)
 156   "Encode the STRING as quoted-printable and return the result."
 157   (with-temp-buffer
 158     (insert string)
 159     (quoted-printable-encode-region (point-min) (point-max))
 160     (buffer-string)))
 161
 162 (provide 'qp)
 163
 164 ;;; qp.el ends here