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

   1 ;;; qp.el --- Quoted-Printable functions
   2 ;; Copyright (C) 1998,99 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   5 ;; This file is part of GNU Emacs.
   6
   7 ;; GNU Emacs is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation; either version 2, or (at your option)
  10 ;; any later version.
  11
  12 ;; GNU Emacs is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  19 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20 ;; Boston, MA 02111-1307, USA.
  21
  22 ;;; Commentary:
  23
  24 ;;; Code:
  25
  26 (require 'mm-util)
  27
  28 (defvar quoted-printable-encoding-characters
  29   (mapcar 'identity "0123456789ABCDEFabcdef"))
  30
  31 (defun quoted-printable-decode-region (from to &optional charset)
  32   "Decode quoted-printable in the region between FROM and TO.
  33 If CHARSET is non-nil, decode the region with charset."
  34   (interactive "r")
  35   (save-excursion
  36     (save-restriction
  37       (let (start)
  38         (narrow-to-region from to)
  39         (goto-char from)
  40         (while (not (eobp))
  41           (cond
  42            ((eq (char-after) ?=)
  43             (delete-char 1)
  44             (unless start
  45               (setq start (point)))
  46             (cond
  47              ;; End of the line.
  48              ((eq (char-after) ?\n)
  49               (delete-char 1))
  50              ;; Encoded character.
  51              ((and
  52                (memq (char-after) quoted-printable-encoding-characters)
  53                (memq (char-after (1+ (point)))
  54                      quoted-printable-encoding-characters))
  55               (insert
  56                (string-to-number
  57                 (buffer-substring (point) (+ 2 (point)))
  58                 16))
  59               (delete-char 2))
  60              ;; Quoted equal sign.
  61              ((eq (char-after) ?=)
  62               (forward-char 1))
  63              ;; End of buffer.
  64              ((eobp))
  65              ;; Invalid.
  66              (t
  67               (message "Malformed MIME quoted-printable message"))))
  68            ((and charset start (not (eq (mm-charset-after) 'ascii)))
  69             (mm-decode-coding-region start (point) charset)
  70             (setq start nil)
  71             (forward-char 1))
  72            (t
  73             (forward-char 1))))
  74         (if (and charset start)
  75             (mm-decode-coding-region start (point) charset))))))
  76
  77 (defun quoted-printable-decode-string (string &optional charset)
  78   "Decode the quoted-printable-encoded STRING and return the results.
  79 If CHARSET is non-nil, decode the region with charset."
  80   (with-temp-buffer
  81     (insert string)
  82     (quoted-printable-decode-region (point-min) (point-max) charset)
  83     (buffer-string)))
  84
  85 (defun quoted-printable-encode-region (from to &optional fold class)
  86   "QP-encode the region between FROM and TO.
  87
  88 If FOLD fold long lines.  If CLASS, translate the characters
  89 matched by that regexp.
  90
  91 If `mm-use-ultra-safe-encoding' is set, fold unconditionally and
  92 encode lines starting with \"From\"."
  93   (interactive "r")
  94   (save-excursion
  95     (save-restriction
  96       (narrow-to-region from to)
  97       ;;      (mm-encode-body)
  98       ;; Encode all the non-ascii and control characters.
  99       (goto-char (point-min))
 100       (while (and (skip-chars-forward
 101                    (or class "^\000-\007\013\015-\037\200-\377="))
 102                   (not (eobp)))
 103         (insert
 104          (prog1
 105              (upcase (format "=%02x" (char-after)))
 106            (delete-char 1))))
 107       ;; Encode white space at the end of lines.
 108       (goto-char (point-min))
 109       (while (re-search-forward "[ \t]+$" nil t)
 110         (goto-char (match-beginning 0))
 111         (while (not (eolp))
 112           (insert
 113            (prog1
 114                (upcase (format "=%02x" (char-after)))
 115              (delete-char 1)))))
 116       (when (or fold mm-use-ultra-safe-encoding)
 117         ;; Fold long lines.
 118         (goto-char (point-min))
 119         (while (not (eobp))
 120           ;; In ultra-safe mode, encode "From " at the beginning of a
 121           ;; line.
 122           (when mm-use-ultra-safe-encoding
 123             (beginning-of-line)
 124             (when (looking-at "From ")
 125               (replace-match "From=20" nil t)))
 126           (end-of-line)
 127           (while (> (current-column) 72)
 128             (beginning-of-line)
 129             (forward-char 71);; 71 char plus an "="
 130             (search-backward "=" (- (point) 2) t)
 131             (insert "=\n")
 132             (end-of-line))
 133           (unless (eobp)
 134             (forward-line)))))))
 135
 136 (defun quoted-printable-encode-string (string)
 137   "QP-encode STRING and return the results."
 138   (mm-with-unibyte-buffer
 139     (insert string)
 140     (quoted-printable-encode-region (point-min) (point-max))
 141     (buffer-string)))
 142
 143 (provide 'qp)
 144
 145 ;; qp.el ends here