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

   1 ;;; qp.el --- Quoted-Printable functions
   2 ;; Copyright (C) 1998, 1999, 2000 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-with-unibyte-current-buffer-mule4
  98         ;;      (mm-encode-body)
  99         ;; Encode all the non-ascii and control characters.
 100         (goto-char (point-min))
 101         (while (and (skip-chars-forward
 102                      ;; Avoid using 8bit characters. = is \075.
 103                      ;; Equivalent to "^\000-\007\013\015-\037\200-\377="
 104                      (or class "\010-\012\014\040-\074\076-\177"))
 105                     (not (eobp)))
 106           (insert
 107            (prog1
 108                (upcase (format "=%02x" (char-after)))
 109              (delete-char 1))))
 110         ;; Encode white space at the end of lines.
 111         (goto-char (point-min))
 112         (while (re-search-forward "[ \t]+$" nil t)
 113           (goto-char (match-beginning 0))
 114           (while (not (eolp))
 115             (insert
 116              (prog1
 117                  (upcase (format "=%02x" (char-after)))
 118                (delete-char 1)))))
 119         (when (or fold mm-use-ultra-safe-encoding)
 120           ;; Fold long lines.
 121           (let ((tab-width 1));; HTAB is one character.
 122             (goto-char (point-min))
 123             (while (not (eobp))
 124               ;; In ultra-safe mode, encode "From " at the beginning of a
 125               ;; line.
 126               (when mm-use-ultra-safe-encoding
 127                 (beginning-of-line)
 128                 (if (looking-at "From ")
 129                     (replace-match "From=20" nil t)
 130                   (if (looking-at "-")
 131                       (replace-match "=2D" nil t))))
 132               (end-of-line)
 133               (while (> (current-column) 76);; tab-width must be 1.
 134                 (beginning-of-line)
 135                 (forward-char 75);; 75 chars plus an "="
 136                 (search-backward "=" (- (point) 2) t)
 137                 (insert "=\n")
 138                 (end-of-line))
 139               (unless (eobp)
 140                 (forward-line)))))))))
 141
 142 (defun quoted-printable-encode-string (string)
 143   "QP-encode STRING and return the results."
 144   (mm-with-unibyte-buffer
 145     (insert string)
 146     (quoted-printable-encode-region (point-min) (point-max))
 147     (buffer-string)))
 148
 149 (provide 'qp)
 150
 151 ;; qp.el ends here