cgit.sxemacs.org Git - gnus/blob - lisp/qp.el

   1 ;;; qp.el --- Quoted-Printable functions
   2
   3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 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 ;;;###autoload
  36 (defun quoted-printable-decode-region (from to &optional coding-system)
  37   "Decode quoted-printable in the region between FROM and TO, per RFC 2045.
  38 If CODING-SYSTEM is non-nil, decode bytes into characters with that
  39 coding-system.
  40
  41 Interactively, you can supply the CODING-SYSTEM argument
  42 with \\[universal-coding-system-argument].
  43
  44 The CODING-SYSTEM argument is a historical hangover and is deprecated.
  45 QP encodes raw bytes and should be decoded into raw bytes.  Decoding
  46 them into characters should be done separately."
  47   (interactive
  48    ;; Let the user determine the coding system with "C-x RET c".
  49    (list (region-beginning) (region-end) coding-system-for-read))
  50   (unless (mm-coding-system-p coding-system) ; e.g. `ascii' from Gnus
  51     (setq coding-system nil))
  52   (save-excursion
  53     (save-restriction
  54       ;; RFC 2045:  ``An "=" followed by two hexadecimal digits, one
  55       ;; or both of which are lowercase letters in "abcdef", is
  56       ;; formally illegal. A robust implementation might choose to
  57       ;; recognize them as the corresponding uppercase letters.''
  58       (let ((case-fold-search t))
  59         (narrow-to-region from to)
  60         ;; Do this in case we're called from Gnus, say, in a buffer
  61         ;; which already contains non-ASCII characters which would
  62         ;; then get doubly-decoded below.
  63         (if coding-system
  64             (mm-encode-coding-region (point-min) (point-max) coding-system))
  65         (goto-char (point-min))
  66         (while (and (skip-chars-forward "^=")
  67                     (not (eobp)))
  68           (cond ((eq (char-after (1+ (point))) ?\n)
  69                  (delete-char 2))
  70                 ((looking-at "=[0-9A-F][0-9A-F]")
  71                  (let ((byte (string-to-int (buffer-substring (1+ (point))
  72                                                               (+ 3 (point)))
  73                                             16)))
  74                    (mm-insert-byte byte 1)
  75                    (delete-char 3)))
  76                 (t
  77                  (error "Malformed quoted-printable text")
  78                  (forward-char)))))
  79       (if coding-system
  80           (mm-decode-coding-region (point-min) (point-max) coding-system)))))
  81
  82 (defun quoted-printable-decode-string (string &optional coding-system)
  83   "Decode the quoted-printable encoded STRING and return the result.
  84 If CODING-SYSTEM is non-nil, decode the region with coding-system."
  85   (with-temp-buffer
  86     (insert string)
  87     (quoted-printable-decode-region (point-min) (point-max) coding-system)
  88     (buffer-string)))
  89
  90 (defun quoted-printable-encode-region (from to &optional fold class)
  91   "Quoted-printable encode the region between FROM and TO per RFC 2045.
  92
  93 If FOLD, fold long lines at 76 characters (as required by the RFC).
  94 If CLASS is non-nil, translate the characters not matched by that
  95 regexp class, which is in the form expected by `skip-chars-forward'.
  96 You should probably avoid non-ASCII characters in this arg.
  97
  98 If `mm-use-ultra-safe-encoding' is set, fold lines unconditionally and
  99 encode lines starting with \"From\"."
 100   (interactive "r")
 101   (save-excursion
 102     (goto-char from)
 103     (if (fboundp 'string-to-multibyte)  ; Emacs 22
 104         (if (re-search-forward (string-to-multibyte "[^\x0-\x7f\x80-\xff]")
 105                                to t)
 106             ;; Fixme: This is somewhat misleading.
 107             (error "Multibyte character in QP encoding region"))
 108       (if (re-search-forward (mm-string-as-multibyte "[^\0-\377]") to t)
 109           (error "Multibyte character in QP encoding region"))))
 110   (unless class
 111     ;; Avoid using 8bit characters. = is \075.
 112     ;; Equivalent to "^\000-\007\013\015-\037\200-\377="
 113     (setq class "\010-\012\014\040-\074\076-\177"))
 114   (save-excursion
 115     (save-restriction
 116       (narrow-to-region from to)
 117       ;; Encode all the non-ascii and control characters.
 118       (goto-char (point-min))
 119       (while (and (skip-chars-forward class)
 120                   (not (eobp)))
 121         (insert
 122          (prog1
 123              ;; To unibyte in case of Emacs 22 eight-bit.
 124              (format "=%02X" (mm-multibyte-char-to-unibyte (char-after)))
 125            (delete-char 1))))
 126       ;; Encode white space at the end of lines.
 127       (goto-char (point-min))
 128       (while (re-search-forward "[ \t]+$" nil t)
 129         (goto-char (match-beginning 0))
 130         (while (not (eolp))
 131           (insert
 132            (prog1
 133                (format "=%02X" (char-after))
 134              (delete-char 1)))))
 135       (let ((mm-use-ultra-safe-encoding
 136              (and (boundp 'mm-use-ultra-safe-encoding)
 137                   mm-use-ultra-safe-encoding)))
 138         (when (or fold mm-use-ultra-safe-encoding)
 139           (let ((tab-width 1))          ; HTAB is one character.
 140             (goto-char (point-min))
 141             (while (not (eobp))
 142               ;; In ultra-safe mode, encode "From " at the beginning
 143               ;; of a line.
 144               (when mm-use-ultra-safe-encoding
 145                 (if (looking-at "From ")
 146                     (replace-match "From=20" nil t)
 147                   (if (looking-at "-")
 148                       (replace-match "=2D" nil t))))
 149               (end-of-line)
 150               ;; Fold long lines.
 151               (while (> (current-column) 76) ; tab-width must be 1.
 152                 (beginning-of-line)
 153                 (forward-char 75)       ; 75 chars plus an "="
 154                 (search-backward "=" (- (point) 2) t)
 155                 (insert "=\n")
 156                 (end-of-line))
 157               (forward-line))))))))
 158
 159 (defun quoted-printable-encode-string (string)
 160   "Encode the STRING as quoted-printable and return the result."
 161   (let ((default-enable-multibyte-characters (mm-multibyte-string-p string)))
 162     (with-temp-buffer
 163       (insert string)
 164       (quoted-printable-encode-region (point-min) (point-max))
 165       (buffer-string))))
 166
 167 (provide 'qp)
 168
 169 ;;; qp.el ends here